delphi 在Firemonkey应用程序中接收Windows消息时遇到问题,例如MM_WOM_DONE

44u64gxh  于 9个月前  发布在  Windows
关注(0)|答案(1)|浏览(146)

我正在尝试将一个工作的VCL示例翻译到Firemonkey,但无法获得MM_WOM_DONE消息超过一天。如何修复“完成”过程以在Firemonkey中接收MM_WOM_DONE?
P.S.在我的真实的应用程序中,我需要构建音频样本真实的时间,因此发送缓冲区到音频播放是至关重要的,这是我发现的唯一适合我的例子。如果有人有任何低延迟的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 。

soat7uwm

soat7uwm1#

与VCL不同,FireMonkey * 不会 * 将未处理的窗口消息发送到虚拟WndProc方法或message处理程序。它只在内部处理它想要的少数消息,然后丢弃其余消息。
因此,您将不得不直接使用SetWindowLongPtr(GWL_WNDPROC)SetWindowSubClass()手动子类化TForm的Win32 HWND,以便捕获任何您想要的额外消息。
参见How detect the mouse back and forward buttons in a Delphi FMX Windows form?以获取此类子类的示例。

相关问题