Changeset 280 for CoolAudio/Systems

Timestamp:

Oct 5, 2011, 12:40:56 PM (13 years ago)

Author:

george

Message:

• Added: Support for play, stop, pause, seek of Windows mmsystem backend.

Location:

CoolAudio/Systems

Files:

• UAudioSystem.pas (modified) (5 diffs)
• UAudioSystemMPlayer.pas (modified) (2 diffs)
• UAudioSystemWindows.pas (modified) (3 diffs)

CoolAudio/Systems/UAudioSystem.pas

@@ -31 +31 @@
   TPlayer = class(TComponent)
   private
-    procedure SetPlaying(AValue: Boolean);
   protected
+    FActive: Boolean;
     FFileName: string;
     FAudioSystem: TAudioSystem;
     FPlaying: Boolean;
-    function GetMuted: Boolean; virtual; abstract;
-    procedure SetMuted(AValue: Boolean); virtual; abstract;
-    function GetLength: TDateTime; virtual; abstract;
-    function GetPosition: TDateTime; virtual; abstract;
-    function GetVolume: Real; virtual; abstract;
-    procedure SetPosition(AValue: TDateTime); virtual; abstract;
-    procedure SetVolume(AValue: Real); virtual; abstract;
+    procedure SetActive(AValue: Boolean); virtual;
+    procedure SetPlaying(AValue: Boolean); virtual;
+    function GetMuted: Boolean; virtual;
+    procedure SetMuted(AValue: Boolean); virtual;
+    function GetLength: TDateTime; virtual;
+    function GetPosition: TDateTime; virtual;
+    function GetVolume: Real; virtual;
+    procedure SetPosition(AValue: TDateTime); virtual;
+    procedure SetVolume(AValue: Real); virtual;
     procedure SetFileName(AValue: string); virtual;
   public
-    procedure Play; virtual; abstract;
-    procedure Pause; virtual; abstract;
-    procedure Stop; virtual; abstract;
+    procedure Play; virtual;
+    procedure Pause; virtual;
+    procedure Stop; virtual;
+    procedure Open; virtual;
+    procedure Close; virtual;
     property Position: TDateTime read GetPosition write SetPosition;
     property Length: TDateTime read GetLength;
@@ -55 +59 @@
     property FileName: string read FFileName write SetFileName;
     property Playing: Boolean read FPlaying write SetPlaying;
+    property Active: Boolean read FActive write SetActive;
     constructor Create; virtual;
+    destructor Destroy; override;
   end;
 
@@ -125 +131 @@
 { TPlayer }
 
+procedure TPlayer.SetActive(AValue: Boolean);
+begin
+  if FActive = AValue then Exit;
+  FActive := AValue;
+end;
+
 procedure TPlayer.SetPlaying(AValue: Boolean);
 begin
@@ -131 +143 @@
 end;
 
+function TPlayer.GetMuted: Boolean;
+begin
+  Result := False;
+end;
+
+procedure TPlayer.SetMuted(AValue: Boolean);
+begin
+end;
+
+function TPlayer.GetLength: TDateTime;
+begin
+  Result := 0;
+end;
+
+function TPlayer.GetPosition: TDateTime;
+begin
+  Result := 0;
+end;
+
+function TPlayer.GetVolume: Real;
+begin
+  Result := 0;
+end;
+
+procedure TPlayer.SetPosition(AValue: TDateTime);
+begin
+end;
+
+procedure TPlayer.SetVolume(AValue: Real);
+begin
+end;
+
 procedure TPlayer.SetFileName(AValue: string);
 begin
@@ -137 +181 @@
 end;
 
+procedure TPlayer.Play;
+begin
+end;
+
+procedure TPlayer.Pause;
+begin
+end;
+
+procedure TPlayer.Stop;
+begin
+end;
+
+procedure TPlayer.Open;
+begin
+  Active := True;
+end;
+
+procedure TPlayer.Close;
+begin
+  Active := False;
+end;
+
 constructor TPlayer.Create;
 begin
-
+end;
+
+destructor TPlayer.Destroy;
+begin
+  Active := False;
+  inherited Destroy;
 end;
 

CoolAudio/Systems/UAudioSystemMPlayer.pas

@@ -105 +105 @@
   tmps := GetEnvironmentVariable('PATH');
   repeat
-    I := pos(':', tmps);
+    I := Pos(PathSeparator, tmps);
     if I = 0 then I := Length(tmps);
     tmppath := IncludeTrailingPathDelimiter(Copy(tmps, 0, I - 1)) + MPlayerExecutableName;
@@ -118 +118 @@
 begin
   inherited Create;
-  FPath := '';
+  FPath := FindPath;
 end;
 

CoolAudio/Systems/UAudioSystemWindows.pas

@@ -7 +7 @@
 {$IFDEF Windows}
 uses
-  Classes, SysUtils, UAudioSystem, MMSystem;
+  Windows, Classes, SysUtils, UAudioSystem, MMSystem, DateUtils;
 
 type
+  TAudioSystemWindows = class(TAudioSystem)
+  public
+    PlayerIndex: Integer;
+  end;
+
+  TMPDeviceTypes = (dtAutoSelect, dtAVIVideo, dtCDAudio, dtDAT, dtDigitalVideo, dtMMMovie,
+    dtOther, dtOverlay, dtScanner, dtSequencer, dtVCR, dtVideodisc, dtWaveAudio);
 
   { TPlayerWindows }
@@ -15 +22 @@
   TPlayerWindows = class(TPlayer)
   private
+    FHandle: HWND;
+    FDeviceId: MCIDEVICEID;
+    FDeviceType: TMPDeviceTypes;
+    FFlags: Longint;
+    FUseNotify: Boolean;
+    FNotify: Boolean;
+    FUseWait: Boolean;
+    FWait: Boolean;
+    FAliasName: string;
+    procedure DoClose;
+    procedure DoOpen;
+    procedure SetDeviceType(AValue: TMPDeviceTypes);
+    procedure CheckError(AValue: Integer);
+    function GetErrorMessage(Code: Integer): string;
+    procedure SetActive(AValue: Boolean); override;
+    procedure SetNotify(AValue: Boolean);
+    procedure SetWait(AValue: Boolean);
+    function GetPosition: TDateTime; override;
+    procedure SetPosition(AValue: TDateTime); override;
+    function GetLength: TDateTime; override;
+  public
     procedure Play; override;
     procedure Pause; override;
     procedure Stop; override;
+    constructor Create; override;
+    destructor Destroy; override;
+    property DeviceType: TMPDeviceTypes read FDeviceType write SetDeviceType;
+    property Handle: HWND read FHandle;
+    property Wait: Boolean read FWait write SetWait;
+    property Notify: Boolean read FNotify write SetNotify;
   end;
 {$ENDIF}
 
+resourcestring
+  SMCIUnknownError = 'Unknown error code';
+
 implementation
 
@@ -27 +64 @@
 { TPlayerWindows }
 
+procedure TPlayerWindows.SetDeviceType(AValue: TMPDeviceTypes);
+begin
+  if FDeviceType = AValue then Exit;
+  FDeviceType := AValue;
+end;
+
+procedure TPlayerWindows.CheckError(AValue: Integer);
+begin
+  if AValue <> 0 then raise Exception.Create('Error ' + IntToStr(AValue) + ': ' + GetErrorMessage(AValue));
+end;
+
+function TPlayerWindows.GetErrorMessage(Code: Integer): string;
+var
+  ErrMsg: array[0..4095] of Char;
+begin
+  if not mciGetErrorString(Code, ErrMsg, SizeOf(ErrMsg)) then
+    Result := SMCIUnknownError
+  else SetString(Result, ErrMsg, StrLen(ErrMsg));
+end;
+
+procedure TPlayerWindows.SetActive(AValue: Boolean);
+begin
+  if FActive = AValue then Exit;
+  inherited SetActive(AValue);
+  if AValue then DoOpen else DoClose;
+end;
+
+procedure TPlayerWindows.SetNotify(AValue: Boolean);
+begin
+  if FNotify = AValue then Exit;
+  FNotify := AValue;
+  FUseNotify := True;
+end;
+
+procedure TPlayerWindows.SetWait(AValue: Boolean);
+begin
+  if FWait = AValue then Exit;
+  FWait := AValue;
+  FUseWait := True;
+end;
+
+function TPlayerWindows.GetPosition: TDateTime;
+var
+  Parm: TMCI_Status_Parms;
+begin
+  FFlags := mci_Wait or mci_Status_Item;
+  Parm.dwItem := mci_Status_Position;
+  CheckError(mciSendCommand(FDeviceID, mci_Status, FFlags, Longint(@Parm)));
+  Result := Parm.dwReturn * OneMillisecond;
+end;
+
+procedure TPlayerWindows.SetPosition(AValue: TDateTime);
+var
+  Parm: TMCI_Seek_Parms;
+begin
+  if FDeviceID <> 0 then begin
+    FFlags := 0;
+    if FUseWait then
+    begin
+      if FWait then FFlags := mci_Wait;
+      FUseWait := False;
+    end
+    else FFlags := mci_Wait;
+    if FUseNotify then
+    begin
+      if FNotify then FFlags := FFlags or mci_Notify;
+      FUseNotify := False;
+    end;
+    FFlags := FFlags or mci_To;
+    Parm.dwTo := Round(AValue / OneMillisecond);
+    CheckError(mciSendCommand(FDeviceID, mci_Seek, FFlags, Longint(@Parm)));
+    if FPlaying then Play;
+  end;
+end;
+
+function TPlayerWindows.GetLength: TDateTime;
+var
+  Parm: TMCI_Status_Parms;
+begin
+  FFlags := mci_Wait or mci_Status_Item;
+  Parm.dwItem := mci_Status_Length;
+  mciSendCommand(FDeviceID, mci_Status, FFlags, Longint(@Parm));
+  Result := Parm.dwReturn * OneMillisecond;
+end;
+
 procedure TPlayerWindows.Play;
-begin
-  PlaySound();
-  sndPlaySound(FFileName, SND_ASYNC);
+var
+  Parm: TMCI_Play_Parms;
+begin
+  if FDeviceID = 0 then DoOpen;
+
+  FFlags := 0;
+  if FUseNotify then
+  begin
+    if FNotify then FFlags := mci_Notify;
+    FUseNotify := False;
+  end else FFlags := mci_Notify;
+  if FUseWait then
+  begin
+    if FWait then FFlags := FFlags or mci_Wait;
+    FUseWait := False;
+  end;
+  CheckError(mciSendCommand(FDeviceID, mci_Play, FFlags, Longint(@Parm)));
+  FPlaying := True;
 end;
 
 procedure TPlayerWindows.Pause;
-begin
-  inherited Pause;
+var
+  Parm: TMCI_Generic_Parms;
+begin
+  if FPlaying then begin
+    CheckError(mciSendCommand(FDeviceID, mci_Pause, FFlags, Longint(@Parm)));
+    FPlaying := False;
+  end else begin
+    CheckError(mciSendCommand(FDeviceID, mci_Resume, FFlags, Longint(@Parm)));
+    FPlaying := True;
+  end;
 end;
 
 procedure TPlayerWindows.Stop;
-begin
-  sndPlaySound(nil, 0);
+var
+  Parm: TMCI_Generic_Parms;
+begin
+  FFlags := 0;
+  if FUseNotify then
+  begin
+    if FNotify then FFlags := mci_Notify;
+    FUseNotify := False;
+  end else FFlags := mci_Notify;
+  if FUseWait then
+  begin
+    if FWait then FFlags := FFlags or mci_Wait;
+    FUseWait := False;
+  end;
+  CheckError(mciSendCommand(FDeviceID, mci_Stop, FFlags, Longint(@Parm)));
+  FPlaying := False;
+end;
+
+constructor TPlayerWindows.Create;
+begin
+  inherited Create;
+end;
+
+destructor TPlayerWindows.Destroy;
+begin
+  Active := False;
+  inherited Destroy;
+end;
+
+procedure TPlayerWindows.DoOpen;
+const
+  DeviceName: array[TMPDeviceTypes] of PChar = ('', 'AVIVideo', 'CDAudio', 'DAT',
+    'DigitalVideo', 'MMMovie', 'Other', 'Overlay', 'Scanner', 'Sequencer',
+    'VCR', 'Videodisc', 'WaveAudio');
+var
+  Parm: TMCI_Open_Parms;
+begin
+  if FDeviceId <> 0 then DoClose;
+
+  FillChar(Parm, SizeOf(TMCI_Open_Parms), 0);
+  Parm.dwCallback := 0;
+  Parm.lpstrDeviceType := DeviceName[FDeviceType];
+  Parm.lpstrElementName := PChar(FFileName);
+
+  FFlags := 0;
+
+  if FUseWait then
+  begin
+    if FWait then FFlags := mci_Wait;
+    FUseWait := False;
+  end
+  else
+    FFlags := mci_Wait;
+
+  if FUseNotify then
+  begin
+    if FNotify then FFlags := FFlags or mci_Notify;
+    FUseNotify := False;
+  end;
+
+  if FDeviceType <> dtAutoSelect then
+    FFlags := FFlags or mci_Open_Type;
+
+  if FDeviceType <> dtAutoSelect then
+    FFlags := FFlags or mci_Open_Type
+  else
+    FFlags := FFlags or MCI_OPEN_ELEMENT;
+
+  //Parm.dwCallback := Handle;
+  CheckError(mciSendCommand(0, mci_Open, FFlags, Longint(@Parm)));
+  FDeviceID := Parm.wDeviceID;
+  FActive := True;
+end;
+
+procedure TPlayerWindows.DoClose;
+var
+  Parm: TMCI_Generic_Parms;
+begin
+  if FDeviceId <> 0 then begin
+    FFlags := 0;
+    if FUseWait then
+    begin
+      if FWait then FFlags := mci_Wait;
+      FUseWait := False;
+    end
+    else FFlags := mci_Wait;
+    if FUseNotify then
+    begin
+      if FNotify then FFlags := FFlags or mci_Notify;
+      FUseNotify := False;
+    end;
+    CheckError(mciSendCommand(FDeviceId, mci_Close, FFlags, Longint(@Parm)));
+    FDeviceId := 0;
+    FActive := False;
+  end;
 end;