FireMonkeyアプリケーションでユーザー定義のWindowsメッセージを受信するには?

FireMonkeyアプリケーションでユーザー定義のWindowsメッセージを受信するには?

ドキュメントを読むと、IFMXApplicationServiceHandleMessageメソッドを使用するみたいです。

下位クラスでは、HandleMessage はアプリケーションのメッセージを処理するための機能を実装します。

FMX.Platform.IFMXApplicationService.HandleMessage – RAD Studio API Documentation」より

サンプルアプリケーションを作りながら動作を確認します。

ボタンを押すとメッセージを送信して、メッセージを受信したらMemo1に表示するアプリを作ります。

フォームにTButtonとTMemoを配置します。

winmsg-1

ボタンを押すと、メッセージを送信します。

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;

実行してみると、正しく動作しているようです。

winmsg-2

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください