Having Trouble Receiving Windows Messages in a Firemonkey Application. Like MM_WOM_DONE

Question

I'm trying to translate a working VCL example to Firemonkey and cannot get MM_WOM_DONE message working for over a day. How do I fix the "Done" procedure to receive the MM_WOM_DONE in Firemonkey?

P.S. In my real app I need to construct the audio sample real time so sending buffers to audio playback is crucial and this is the only example that I found that works for me. If anybody has any example with low latency working for FMX I'd be grateful.

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, waveio, MMSystem, Windows, Messaging, FMX.Platform.Win;

const
  BUFFER_LENGTH = 100;
  NUM_BUFFERS = 8;
  GRAPH_WIDTH = 200;

type
  TFormMain = class(TForm)
    button1: TButton;
    procedure button1Click(Sender: TObject);
  private
    { Private declarations }
    ws: TFileWaveStream;
    PCMReader: TPCMWaveReader;
    Headers: array [0..NUM_BUFFERS-1] of TWaveHdr;
    BufferLength: Longint;
    CurrentBuffer, Ending: Integer;
    waveout: HWaveOut;
    Graphic: array [0..GRAPH_WIDTH-1, 0..1] of Byte;
    Closing: Boolean;
    procedure OpenFile( FileName: String );
    procedure CloseFile;
    procedure WriteBuffer;
    procedure Done( var Msg: TMessage ); message MM_WOM_DONE;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

procedure TFormMain.OpenFile( FileName: String );
var
  Cnt: Integer;
begin
  ws := TFileWaveStream.Create( FileName, nil );
  PCMReader := TPCMWaveReader.Create( ws );

  CurrentBuffer := 0;
  Ending := 1;
  Closing := False;
  BufferLength := ((PCMReader.Format^.nAvgBytesPerSec * BUFFER_LENGTH)
    div (1000 * PCMReader.Format^.nBlockAlign)) * PCMReader.Format^.nBlockAlign;

  if (PCMReader.Size > 0) then
  begin
    waveOutOpen( @waveout, WAVE_MAPPER, PCMReader.Format, WindowHandleToPlatform(Self.Handle).Wnd,
      Integer(self), CALLBACK_WINDOW or WAVE_ALLOWSYNC );

    for Cnt := 0 to NUM_BUFFERS-1 do
    begin
      ZeroMemory(@Headers[Cnt], sizeof(Headers[Cnt]));
      with Headers[Cnt] do
      begin
        GetMem( lpData, BufferLength );
        dwBufferLength := BufferLength;
        dwFlags := WHDR_DONE;
      end;
      waveOutPrepareHeader( waveout, @(Headers[Cnt]), sizeof(Headers[Cnt]) );
    end;

    for Cnt := 0 to NUM_BUFFERS-1 do
      WriteBuffer;

  end;
end;

procedure TFormMain.CloseFile;
var
  Cnt: Integer;
  p: Pointer;
begin
  if (waveout <> 0) then
  begin
    Closing := True;

    waveOutReset( waveout );

    for Cnt := 0 to NUM_BUFFERS-1 do
    begin
      p := Headers[Cnt].lpData;
      waveOutUnprepareHeader( waveout, @Headers[Cnt], sizeof(Headers[Cnt]) );
      FreeMem( p );
    end;

    waveOutClose( waveout );

    waveout := 0;
  end;

  if (PCMReader <> nil) then
    PCMReader.Free;
  PCMReader := nil;

  if (ws <> nil) then
    ws.Free;
  ws := nil;
end;


procedure TFormMain.WriteBuffer;
var
  sw: Integer;
begin
  if (Closing) then exit;

  sw := PCMReader.Read( Headers[CurrentBuffer].lpData^,
    BufferLength div PCMReader.Format^.nBlockAlign )
    * PCMReader.Format^.nBlockAlign;
  if (sw > 0) then
  begin
    if BufferLength <> sw then
      if PCMReader.Format^.wBitsPerSample = 8 then
        FillMemory( PChar(Headers[CurrentBuffer].lpData) + sw,
          BufferLength - sw, 128 )
      else
        ZeroMemory( PChar(Headers[CurrentBuffer].lpData) + sw,
          BufferLength - sw );
    waveOutWrite( waveout, @Headers[CurrentBuffer],
      sizeof(Headers[CurrentBuffer]) );
  end
  else
    if (Ending < NUM_BUFFERS) then
      Inc( Ending );
    //else
    //  PostMessage( WindowHandleToPlatform(Self.Handle).Wnd, WM_USER, 0, 0 );

  CurrentBuffer := (CurrentBuffer + 1) mod NUM_BUFFERS;
end;

procedure TFormMain.Done( var Msg: TMessage );
begin
  WriteBuffer;
end;

procedure TFormMain.button1Click(Sender: TObject);
begin
    CloseFile;
    OpenFile( 'C:\Users\M\Documents\Rhodes C notest.wav' );
end;

end.

I tried opening an invisible window through the Windows API just to be able to make MM_WOM_DONE possible. I couldn't make it work but it's probably due to my lack of knowledge of how this is being done in recent versions of Delphi.

Answer 1

Unlike VCL, FireMonkey does not dispatch unhandled window messages to the virtual WndProc method or to message handlers. It only handles a select few messages it wants internally, and then discards the rest.

As such, you will have to manually subclass the TForm's Win32 HWND directly using SetWindowLongPtr(GWL_WNDPROC) or SetWindowSubClass() in order to catch any extra messages you want.

See How detect the mouse back and forward buttons in a Delphi FMX Windows form? for an example of such subclassing.