在 Firemonkey 应用程序中接收 Windows 消息时遇到问题。喜欢 MM_WOM_DONE

Question

我正在尝试将一个工作的 VCL 示例转换为 Firemonkey，但无法让 MM_WOM_DONE 消息工作超过一天。如何修复“完成”过程以在 Firemonkey 中接收 MM_WOM_DONE？

附注在我的真实应用程序中，我需要实时构建音频样本，因此将缓冲区发送到音频播放至关重要，这是我发现对我有用的唯一示例。如果有人有任何适用于 FMX 的低延迟示例，我将不胜感激。

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.

我尝试通过 Windows API 打开一个不可见的窗口，只是为了能够使 MM_WOM_DONE 成为可能。我无法让它工作，但这可能是因为我不知道在最新版本的 Delphi 中这是如何完成的。

Answer 1

与 VCL 不同，FireMonkey 不会将未处理的窗口消息分派到虚拟

WndProc

方法或

message

处理程序。它只在内部处理它想要的少数消息，然后丢弃其余的。

因此，您必须直接使用

TForm 或

HWND

手动对 SetWindowLongPtr(GWL_WNDPROC)

 的 Win32 

SetWindowSubClass() 进行子类化，才能捕获您想要的任何额外消息。

有关此类子类化的示例，请参阅如何在 Delphi FMX Windows 窗体中检测鼠标后退和前进按钮？。