FireMonkeyアプリケーションでユーザー定義のWindowsメッセージを受信するには?
ドキュメントを読むと、IFMXApplicationServiceのHandleMessageメソッドを使用するみたいです。
下位クラスでは、HandleMessage はアプリケーションのメッセージを処理するための機能を実装します。
「FMX.Platform.IFMXApplicationService.HandleMessage – RAD Studio API Documentation」より
サンプルアプリケーションを作りながら動作を確認します。
ボタンを押すとメッセージを送信して、メッセージを受信したらMemo1に表示するアプリを作ります。
フォームにTButtonとTMemoを配置します。
ボタンを押すと、メッセージを送信します。
const
WM_HOGEHOGE = WM_USER + 100;
procedure TForm1.Button1Click(Sender: TObject);
var
WindowHandle: TWinWindowHandle;
begin
WindowHandle := WindowHandleToPlatform(Form1.Handle);
Winapi.Windows.PostMessage(WindowHandle.Wnd, WM_HOGEHOGE, WPARAM(0),
LPARAM(0));
end;
IFMXApplicationServiceインターフェースを継承したクラスを作成します。
type
TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
public
procedure Run;
function HandleMessage: Boolean;
procedure WaitMessage;
function GetDefaultTitle: string;
function GetTitle: string;
procedure SetTitle(const Value: string);
function GetVersionString: string;
procedure Terminate;
function Terminating: Boolean;
property DefaultTitle: string read GetDefaultTitle;
property Title: string read GetTitle write SetTitle;
property AppVersion: string read GetVersionString;
end;
変数を追加します。
type
TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
private
class var OldFMXApplicationService: IFMXApplicationService;
class var NewFMXApplicationService: IFMXApplicationService;
OldFMXApplicationServiceはIFMXApplicationServiceを継承した標準で使用されているオブジェクト、
NewFMXApplicationServiceは新しく作成するオブジェクトです。
TFMXApplicationServiceクラスを登録する処理を追加します。
type
TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
private
class procedure AddPlatformService;
class procedure TFMXApplicationService.AddPlatformService;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService,
IInterface(OldFMXApplicationService)) then
begin
TPlatformServices.Current.RemovePlatformService(IFMXApplicationService);
NewFMXApplicationService := TFMXApplicationService.Create;
TPlatformServices.Current.AddPlatformService(IFMXApplicationService,
NewFMXApplicationService);
end;
end;
既存のIFMXApplicationServiceオブジェクトをOldFMXApplicationServiceに代入し、作成したTFMXApplicationServiceオブジェクトを登録します。
起動時に、TFMXApplicationService.AddPlatformServiceメソッドを呼び、TFMXApplicationServiceオブジェクトを登録します。
initialization
TFMXApplicationService.AddPlatformService;
TFMXApplicationServiceクラスは、HandleMessageメソッド以外の処理はOldFMXApplicationServiceオブジェクトに委譲します。
function TFMXApplicationService.GetDefaultTitle: string;
begin
Result := OldFMXApplicationService.GetDefaultTitle;
end;
function TFMXApplicationService.GetTitle: string;
begin
Result := OldFMXApplicationService.GetTitle;
end;
function TFMXApplicationService.GetVersionString: string;
begin
Result := OldFMXApplicationService.GetVersionString;
end;
procedure TFMXApplicationService.Run;
begin
OldFMXApplicationService.Run;
end;
procedure TFMXApplicationService.SetTitle(const Value: string);
begin
OldFMXApplicationService.SetTitle(Value);
end;
procedure TFMXApplicationService.Terminate;
begin
OldFMXApplicationService.Terminate;
end;
function TFMXApplicationService.Terminating: Boolean;
begin
Result := OldFMXApplicationService.Terminating;
end;
procedure TFMXApplicationService.WaitMessage;
begin
OldFMXApplicationService.WaitMessage;
end;
TFMXApplicationServiceクラスのHandleMessageメソッドでは、受信したメッセージがWM_HOGEHOGEのときはTForm1のMemo1に’WM_HOGEHOGE’を追加し、その他の時は標準の処理を行います。
function TFMXApplicationService.HandleMessage: Boolean;
var
Msg: TMsg;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
Result := True;
if Msg.Message = WM_HOGEHOGE then
begin
(Application.MainForm as TForm1).Memo1.Lines.Add('WM_HOGEHOGE');
end
else if Msg.Message <> WM_QUIT then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end
else
Application.Terminated := True;
end;
end;
実行してみると、正しく動作しているようです。