我正在尝试将一个工作的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 。
1条答案
按热度按时间soat7uwm1#
与VCL不同,FireMonkey * 不会 * 将未处理的窗口消息发送到虚拟
WndProc
方法或message
处理程序。它只在内部处理它想要的少数消息,然后丢弃其余消息。因此,您将不得不直接使用
SetWindowLongPtr(GWL_WNDPROC)
或SetWindowSubClass()
手动子类化TForm
的Win32HWND
,以便捕获任何您想要的额外消息。参见How detect the mouse back and forward buttons in a Delphi FMX Windows form?以获取此类子类的示例。