Changeset 201 for trunk/Packages/CevoComponents/Sound.pas

Timestamp:

May 8, 2020, 11:14:09 AM (5 years ago)

Author:

chronos

Message:

• Fixed: Sound was played only once because LCL doesn't handle MM_MCINOTIFY message in same way as Delphi does. Added workaround to capture and handle that message.

File:

• trunk/Packages/CevoComponents/Sound.pas (modified) (7 diffs)

trunk/Packages/CevoComponents/Sound.pas

@@ -12 +12 @@
   TPlayStyle = (psAsync, psSync);
 
+  { TSoundPlayer }
+
   TSoundPlayer = class(TForm)
   private
     {$IFDEF WINDOWS}
+    PrevWndProc: WNDPROC;
     procedure OnMCI(var m: TMessage); message MM_MCINOTIFY;
+  public
+    constructor Create(AOwner: TComponent); override;
     {$ENDIF}
   end;
@@ -23 +28 @@
   TSound = class
   private
+    {$IFDEF LINUX}
     PlayCommand: string;
-    {$IFDEF LINUX}
     SoundPlayerAsyncProcess: TAsyncProcess;
     SoundPlayerSyncProcess: TProcess;
@@ -82 +87 @@
     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
@@ -239 +244 @@
 
 {$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;
     PlayingSound := nil;
   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}
@@ -274 +300 @@
 
 function Play(Item: string; Index: Integer = -1): Boolean;
-{$IFNDEF DEBUG}
 var
   WavFileName: string;
-{$ENDIF}
 begin
   Result := False;
-{$IFNDEF DEBUG}
   if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
   begin
@@ -292 +315 @@
     // SndPlaySound(pchar(GetSoundsDir + DirectorySeparator + WavFileName + '.wav'), SND_ASYNC)
     PlaySound(GetSoundsDir + DirectorySeparator + WavFileName);
-{$ENDIF}
 end;
 
 procedure PreparePlay(Item: string; Index: Integer = -1);
-{$IFNDEF DEBUG}
 var
   WavFileName: string;
-{$ENDIF}
-begin
-{$IFNDEF DEBUG}
+begin
   if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
     Exit;
@@ -308 +327 @@
   if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then
     PrepareSound(GetSoundsDir + DirectorySeparator + WavFileName);
-{$ENDIF}
 end;