FireMonkey应用无法接收MM_WOM_DONE消息的解决方法问询

FireMonkey的窗口消息机制和VCL差异很大，直接用message关键字绑定窗口消息无法生效，以下是两种可靠的解决方法：

方法1：改用函数回调（推荐，无需窗口依赖） #

放弃窗口回调模式，改用CALLBACK_FUNCTION类型的回调函数直接处理波形消息：

1. 在单元interface部分添加回调类型定义：

type
  TWaveOutCallback = procedure(hwo: HWaveOut; uMsg: UINT; dwInstance: DWORD_PTR; dwParam1: DWORD_PTR; dwParam2: DWORD_PTR); stdcall;

2. 修改TFormMain类定义，添加静态回调方法：

type
  TFormMain = class(TForm)
    button1: TButton;
    procedure button1Click(Sender: TObject);
  private
    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;
    class procedure WaveOutCallback(hwo: HWaveOut; uMsg: UINT; dwInstance: DWORD_PTR; dwParam1: DWORD_PTR; dwParam2: DWORD_PTR); stdcall;
  public
  end;

3. 实现回调函数，处理MM_WOM_DONE消息：

class procedure TFormMain.WaveOutCallback(hwo: HWaveOut; uMsg: UINT; dwInstance: DWORD_PTR; dwParam1: DWORD_PTR; dwParam2: DWORD_PTR);
var
  Form: TFormMain;
begin
  Form := TFormMain(dwInstance);
  if Assigned(Form) and (uMsg = MM_WOM_DONE) then
    Form.WriteBuffer;
end;

4. 修改waveOutOpen调用，切换到回调模式：

waveOutOpen(@waveout, WAVE_MAPPER, PCMReader.Format, DWORD_PTR(@TFormMain.WaveOutCallback), DWORD_PTR(Self), CALLBACK_FUNCTION or WAVE_ALLOWSYNC);

方法2：创建隐藏窗口处理消息 #

如果坚持用窗口回调，手动创建一个原生Win32隐藏窗口来接收消息：

1. 修改TFormMain类定义，添加隐藏窗口相关成员：

type
  TFormMain = class(TForm)
    button1: TButton;
    procedure button1Click(Sender: TObject);
  private
    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;
    FHiddenWnd: HWND;
    procedure OpenFile(FileName: String);
    procedure CloseFile;
    procedure WriteBuffer;
    function HiddenWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

2. 实现隐藏窗口的创建、销毁和消息处理：

constructor TFormMain.Create(AOwner: TComponent);
var
  WndClass: TWndClass;
begin
  inherited;
  // 注册窗口类
  WndClass.lpszClassName := 'WaveOutHiddenWnd';
  WndClass.lpfnWndProc := @HiddenWndProc;
  WndClass.hInstance := HInstance;
  WndClass.style := CS_HREDRAW or CS_VREDRAW;
  WndClass.hIcon := 0;
  WndClass.hCursor := 0;
  WndClass.hbrBackground := 0;
  WndClass.lpszMenuName := nil;
  WndClass.cbClsExtra := 0;
  WndClass.cbWndExtra := 0;
  RegisterClass(WndClass);
  // 创建隐藏窗口，将Form实例绑定到窗口
  FHiddenWnd := CreateWindowEx(0, 'WaveOutHiddenWnd', '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, Self);
  SetWindowLongPtr(FHiddenWnd, GWLP_USERDATA, DWORD_PTR(Self));
end;

destructor TFormMain.Destroy;
begin
  if FHiddenWnd <> 0 then
    DestroyWindow(FHiddenWnd);
  UnregisterClass('WaveOutHiddenWnd', HInstance);
  inherited;
end;

function TFormMain.HiddenWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  Form: TFormMain;
begin
  Form := TFormMain(GetWindowLongPtr(hWnd, GWLP_USERDATA));
  if Assigned(Form) and (uMsg = MM_WOM_DONE) then
  begin
    Form.WriteBuffer;
    Result := 0;
    Exit;
  end;
  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;

3. 修改waveOutOpen调用，使用隐藏窗口句柄：

waveOutOpen(@waveout, WAVE_MAPPER, PCMReader.Format, FHiddenWnd, DWORD_PTR(Self), CALLBACK_WINDOW or WAVE_ALLOWSYNC);

WaveOut API的延迟表现有限，如果需要低延迟实时音频，推荐使用以下方案：

1. WASAPI原生接口（Windows平台） #

WASAPI是Windows原生低延迟音频接口，支持独占模式和低延迟缓冲区配置，核心逻辑如下：

uses
  Winapi.Windows, Winapi.AudioClient, Winapi.MMReg, Winapi.Audiopolicy;

type
  TAudioPlayer = class
  private
    FAudioClient: IAudioClient;
    FAudioRenderClient: IAudioRenderClient;
    FBufferFrameCount: UINT;
    procedure InitAudio;
    procedure FillBuffer;
  public
    constructor Create;
    procedure Start;
    procedure Stop;
  end;

constructor TAudioPlayer.Create;
begin
  InitAudio;
end;

procedure TAudioPlayer.InitAudio;
var
  MixFormat: WAVEFORMATEX;
  hResult: HRESULT;
  FDevice: IMMDevice;
  FEnumerator: IMMDeviceEnumerator;
begin
  CoCreateInstance(CLSID_MMDeviceEnumerator, nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, FEnumerator);
  FEnumerator.GetDefaultAudioEndpoint(eRender, eConsole, FDevice);
  FDevice.Activate(IID_IAudioClient, CLSCTX_ALL, nil, FAudioClient);

  // 配置PCM格式：44.1kHz 16位立体声
  ZeroMemory(@MixFormat, sizeof(MixFormat));
  MixFormat.wFormatTag := WAVE_FORMAT_PCM;
  MixFormat.nChannels := 2;
  MixFormat.nSamplesPerSec := 44100;
  MixFormat.wBitsPerSample := 16;
  MixFormat.nBlockAlign := (MixFormat.nChannels * MixFormat.wBitsPerSample) div 8;
  MixFormat.nAvgBytesPerSec := MixFormat.nSamplesPerSec * MixFormat.nBlockAlign;

  // 初始化独占模式，低延迟配置
  FAudioClient.Initialize(AUDCLNT_SHAREMODE_EXCLUSIVE, AUDCLNT_STREAMFLAGS_EVENTCALLBACK, 0, 0, @MixFormat, nil);
  FAudioClient.GetBufferSize(@FBufferFrameCount);
  FAudioClient.GetService(IID_IAudioRenderClient, FAudioRenderClient);
end;

procedure TAudioPlayer.Start;
begin
  FAudioClient.Start;
  // 启动线程循环填充缓冲区
  TThread.CreateAnonymousThread(procedure
  begin
    while True do
    begin
      FillBuffer;
      Sleep(1);
    end;
  end).Start;
end;

procedure TAudioPlayer.FillBuffer;
var
  pData: PByte;
  hResult: HRESULT;
begin
  hResult := FAudioRenderClient.GetBuffer(FBufferFrameCount, @pData);
  if hResult = S_OK then
  begin
    // 在这里填充实时生成的PCM采样数据
    // 示例：生成测试波形
    FillMemory(pData, FBufferFrameCount * 4, 0);
    FAudioRenderClient.ReleaseBuffer(FBufferFrameCount, 0);
  end;
end;

2. 第三方音频库 #

可以使用成熟的跨平台音频库（如BASS），它支持FMX，内置低延迟播放功能，集成简单，只需调用库API即可实现实时音频缓冲提交。

内容的提问来源于stack exchange，提问作者Lanmi