Changeset 210 for branches/highdpi/Packages/CevoComponents/Sound.pas

Timestamp:

May 9, 2020, 4:02:07 PM (5 years ago)

Author:

chronos

Message:

• Modified: Improved HighDPI branch. Imported new changes from trunk branch.

File:

• branches/highdpi/Packages/CevoComponents/Sound.pas (modified) (12 diffs)

branches/highdpi/Packages/CevoComponents/Sound.pas

@@ -4 +4 @@
 
 uses
-  Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl
-  {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF};
+  UDpiControls, SysUtils, Classes, Graphics, Controls, Forms, fgl, FileUtil,
+  StringTables, Directories
+  {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF}
+  {$IFDEF LINUX}, Process, AsyncProcess{$ENDIF};
 
 type
-  TSoundPlayer = class(TForm)
+  TPlayStyle = (psAsync, psSync);
+
+  { TSoundPlayer }
+
+  TSoundPlayer = class(TDpiForm)
   private
     {$IFDEF WINDOWS}
+    PrevWndProc: WNDPROC;
     procedure OnMCI(var m: TMessage); message MM_MCINOTIFY;
+  public
+    constructor Create(AOwner: TComponent); override;
     {$ENDIF}
   end;
 
-function PrepareSound(FileName: string): integer;
-procedure PlaySound(FileName: string);
-
-implementation
-
-{$R *.lfm}
-
-type
+  { TSound }
+
   TSound = class
+  private
+    {$IFDEF LINUX}
+    PlayCommand: string;
+    SoundPlayerAsyncProcess: TAsyncProcess;
+    SoundPlayerSyncProcess: TProcess;
+    {$ENDIF}
+    function GetNonWindowsPlayCommand: string;
   public
-    FDeviceID: word;
+    FDeviceID: Word;
     FFileName: string;
+    PlayStyle: TPlayStyle;
     constructor Create(const FileName: string);
     destructor Destroy; override;
@@ -34 +45 @@
   end;
 
+function PrepareSound(FileName: string): Integer;
+procedure PlaySound(FileName: string);
+function Play(Item: string; Index: Integer = -1): Boolean;
+procedure PreparePlay(Item: string; Index: Integer = -1);
+
+const
+  // sound modes
+  smOff = 0;
+  smOn = 1;
+  smOnAlt = 2;
+
+var
+  Sounds: TStringTable;
+  SoundMode: Integer;
+  SoundPlayer: TSoundPlayer;
+  SoundList: TFPGObjectList<TSound>;
+  PlayingSound: TSound;
+
+
+implementation
+
+{$R *.lfm}
+
+resourcestring
+  SUnableToPlay = 'PlayStyle=%s: Unable to play %s Message:%s';
+  SPlayCommandNotWork = 'The play command %s does not work on your system';
 
 constructor TSound.Create(const FileName: string);
@@ -41 +78 @@
 {$ENDIF}
 begin
+  PlayStyle := psAsync;
+  FFileName := FileName;
   {$IFDEF WINDOWS}
   FDeviceID := 0;
-  FFileName := FileName;
-  if FileExists(FFileName) then
-  begin
+  if FileExists(FFileName) then begin
     OpenParm.dwCallback := 0;
     OpenParm.lpstrDeviceType := 'WaveAudio';
     OpenParm.lpstrElementName := PChar(FFileName);
     mciSendCommand(0, MCI_Open, MCI_WAIT or MCI_OPEN_ELEMENT or
-      MCI_OPEN_SHAREABLE, integer(@OpenParm));
+      MCI_OPEN_SHAREABLE, DWORD_PTR(@OpenParm));
     FDeviceID := OpenParm.wDeviceID;
   end
   {$ENDIF}
+  {$IFDEF LINUX}
+  PlayCommand := GetNonWindowsPlayCommand;
+  FDeviceID := 1;
+  {$ENDIF}
 end;
 
@@ -62 +103 @@
     mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0);
   {$ENDIF}
-  inherited Destroy;
-end;
+  {$IFDEF LINUX}
+  FreeAndNil(SoundPlayerSyncProcess);
+  FreeAndNil(SoundPlayerAsyncProcess);
+  {$ENDIF}
+  inherited;
+end;
+
+function TSound.GetNonWindowsPlayCommand: string;
+begin
+  Result := '';
+  // Try play
+  if (FindDefaultExecutablePath('play') <> '') then
+    Result := 'play';
+  // Try aplay
+  if (result = '') then
+    if (FindDefaultExecutablePath('aplay') <> '') then
+      Result := 'aplay -q';
+  // Try paplay
+  if (Result = '') then
+    if (FindDefaultExecutablePath('paplay') <> '') then
+      Result := 'paplay';
+  // Try mplayer
+  if (Result = '') then
+    if (FindDefaultExecutablePath('mplayer') <> '') then
+      Result := 'mplayer -really-quiet';
+  // Try CMus
+  if (Result = '') then
+    if (FindDefaultExecutablePath('CMus') <> '') then
+      Result := 'CMus';
+  // Try pacat
+  if (Result = '') then
+    if (FindDefaultExecutablePath('pacat') <> '') then
+      Result := 'pacat -p';
+  // Try ffplay
+  if (Result = '') then
+    if (FindDefaultExecutablePath('ffplay') <> '') then
+      result := 'ffplay -autoexit -nodisp';
+  // Try cvlc
+  if (Result = '') then
+    if (FindDefaultExecutablePath('cvlc') <> '') then
+      result := 'cvlc -q --play-and-exit';
+  // Try canberra-gtk-play
+  if (Result = '') then
+    if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then
+      Result := 'canberra-gtk-play -c never -f';
+  // Try Macintosh command?
+  if (Result = '') then
+    if (FindDefaultExecutablePath('afplay') <> '') then
+      Result := 'afplay';
+end;
+
 
 procedure TSound.Play(HWND: DWORD);
@@ -69 +159 @@
 var
   PlayParm: TMCI_Play_Parms;
+{$ENDIF}
+{$IFDEF LINUX}
+var
+  L: TStringList;
+  I: Integer;
 {$ENDIF}
 begin
@@ -78 +173 @@
   end
   {$ENDIF}
+  {$IFDEF LINUX}
+  // How to play in Linux? Use generic Linux commands
+  // Use asyncprocess to play sound as SND_ASYNC
+  // proceed if we managed to find a valid command
+  if PlayCommand <> '' then begin
+    L := TStringList.Create;
+    try
+      L.Delimiter := ' ';
+      L.DelimitedText := PlayCommand;
+      if PlayStyle = psASync then begin
+        if SoundPlayerAsyncProcess = nil then
+          SoundPlayerAsyncProcess := TAsyncProcess.Create(nil);
+        SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(FFilename);
+        SoundPlayerAsyncProcess.Executable := FindDefaultExecutablePath(L[0]);
+        SoundPlayerAsyncProcess.Parameters.Clear;
+        for I := 1 to L.Count - 1 do
+          SoundPlayerAsyncProcess.Parameters.Add(L[I]);
+        SoundPlayerAsyncProcess.Parameters.Add(FFilename);
+        try
+          SoundPlayerAsyncProcess.Execute;
+        except
+          On E: Exception do
+            E.CreateFmt(SUnableToPlay, ['paASync', FFilename, E.Message]);
+        end;
+        PlayingSound := nil;
+      end else begin
+        if SoundPlayerSyncProcess = nil then
+          SoundPlayerSyncProcess := TProcess.Create(nil);
+        SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(FFilename);
+        SoundPlayerSyncProcess.Executable := FindDefaultExecutablePath(L[0]);
+        SoundPlayersyncProcess.Parameters.Clear;
+        for I := 1 to L.Count - 1 do
+          SoundPlayerSyncProcess.Parameters.Add(L[I]);
+        SoundPlayerSyncProcess.Parameters.Add(FFilename);
+        try
+          SoundPlayerSyncProcess.Execute;
+          SoundPlayersyncProcess.WaitOnExit;
+        except
+          On E: Exception do
+            E.CreateFmt(SUnableToPlay, ['paSync', FFilename, E.Message]);
+        end;
+        PlayingSound := nil;
+      end;
+    finally
+      L.Free;
+    end;
+  end
+  else
+    raise Exception.CreateFmt(SPlayCommandNotWork, [PlayCommand]);
+  {$ENDIF}
 end;
 
@@ -85 +230 @@
   mciSendCommand(FDeviceID, MCI_STOP, 0, 0);
   {$ENDIF}
+  {$IFDEF LINUX}
+  if SoundPlayerSyncProcess <> nil then SoundPlayerSyncProcess.Terminate(1);
+  if SoundPlayerAsyncProcess <> nil then SoundPlayerAsyncProcess.Terminate(1);
+  {$ENDIF}
 end;
 
@@ -94 +243 @@
 end;
 
-
-var
-  SoundPlayer: TSoundPlayer;
-  SoundList: TFPGObjectList<TSound>;
-  PlayingSound: TSound;
-
 {$IFDEF WINDOWS}
+function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam):LRESULT; stdcall;
+var
+  Message: TMessage;
+begin
+  if (uMsg = MM_MCINOTIFY) then begin
+    Message.msg := uMsg;
+    Message.wParam := wParam;
+    Message.lParam := lParam;
+    SoundPlayer.OnMCI(Message);
+  end;
+  Result := CallWindowProc(SoundPlayer.PrevWndProc, Ahwnd, uMsg, WParam, LParam);
+end;
+
 procedure TSoundPlayer.OnMCI(var m: TMessage);
 begin
-  if (m.wParam = MCI_Notify_Successful) and (PlayingSound <> nil) then
+  if (m.wParam = MCI_NOTIFY_SUCCESSFUL) and (PlayingSound <> nil) then
   begin
     PlayingSound.Reset;
@@ -109 +265 @@
   end;
 end;
+
+constructor TSoundPlayer.Create(AOwner: TComponent);
+begin
+  inherited;
+  // MM_MCINOTIFY is not handled by LCL, fallback to low lever handling
+  // https://wiki.lazarus.freepascal.org/Win32/64_Interface#Processing_non-user_messages_in_your_window
+  PrevWndProc := Windows.WNDPROC(SetWindowLongPtr(Self.Handle, GWL_WNDPROC, PtrInt(@WndCallback)));
+end;
 {$ENDIF}
 
-function PrepareSound(FileName: string): integer;
+function PrepareSound(FileName: string): Integer;
 begin
   Result := 0;
-  while (result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do
-    inc(result);
-  if result = SoundList.Count then begin
-    // first time this sound is played
+  while (Result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do
+    Inc(Result);
+  if Result = SoundList.Count then begin
+    // First time this sound is played
     SoundList.Add(TSound.Create(FileName));
     Result := SoundList.Count - 1;
@@ -125 +289 @@
 procedure PlaySound(FileName: string);
 begin
-  if PlayingSound <> nil then
-    exit;
+  if PlayingSound <> nil then Exit;
   if SoundPlayer = nil then
-    Application.CreateForm(TSoundPlayer, SoundPlayer);
+    DpiApplication.CreateForm(TSoundPlayer, SoundPlayer);
   PlayingSound := SoundList[PrepareSound(FileName)];
   if PlayingSound.FDeviceID = 0 then
@@ -136 +299 @@
 end;
 
+function Play(Item: string; Index: Integer = -1): Boolean;
+var
+  WavFileName: string;
+begin
+  Result := False;
+  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
+  begin
+    Result := True;
+    Exit;
+  end;
+  WavFileName := Sounds.Lookup(Item, Index);
+  Assert(WavFileName[1] <> '[');
+  Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');
+  if Result then
+    // SndPlaySound(pchar(GetSoundsDir + DirectorySeparator + WavFileName + '.wav'), SND_ASYNC)
+    PlaySound(GetSoundsDir + DirectorySeparator + WavFileName);
+end;
+
+procedure PreparePlay(Item: string; Index: Integer = -1);
+var
+  WavFileName: string;
+begin
+  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
+    Exit;
+  WavFileName := Sounds.Lookup(Item, Index);
+  Assert(WavFileName[1] <> '[');
+  if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then
+    PrepareSound(GetSoundsDir + DirectorySeparator + WavFileName);
+end;
+
 procedure UnitInit;
 begin
@@ -150 +343 @@
   end;
   FreeAndNil(SoundList);
+  if Sounds <> nil then
+    FreeAndNil(Sounds);
 end;