[Delphi] FireMonkey で Window Message を受け取る

# Window Message

Windows はアプリケーションに対して必要に応じて「メッセージ」を送ります。
例えば、描画が必要であれば「[WM_PAINT](https://docs.microsoft.com/en-us/windows/win32/gdi/wm-paint)」を、マウスの左ボタンが押されたら「[WM_LBUTTONDOWN](https://docs.microsoft.com/ja-jp/windows/win32/inputdev/wm-lbuttondown)」を、といった具合です。

# Delphi/VCL で Message を受け取る

VCL の場合は簡単で、

```pascal
type
  TForm1 = class(TForm)
  private
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  end;
```

と、[message 指令](http://docwiki.embarcadero.com/RADStudio/Sydney/ja/%E3%83%A1%E3%82%BD%E3%83%83%E3%83%89%EF%BC%88Delphi%EF%BC%89#.E3.83.A1.E3.83.83.E3.82.BB.E3.83.BC.E3.82.B8_.E3.83.A1.E3.82.BD.E3.83.83.E3.83.89)を使うだけです。
これで、message に書かれたメッセージが来たときに、メソッドが呼ばれます。

# Delphi/FireMonkey で Message を受け取る

FireMonkey の場合は、ちょっと大変です。
というのは、[FireMonkey](http://docwiki.embarcadero.com/RADStudio/Sydney/ja/FireMonkey) はマルチプラットフォーム用のフレームワークだからです。

「Message で通知する」というのは Windows の流儀であって、他の OS には無いものです（Windows と全く同様な方法のものは）。
そのため、FireMonkey では Window Message の部分は隠蔽されています。

また、FireMonkey はコントロールも自分で描いています（[ControlType](http://docwiki.embarcadero.com/Libraries/Sydney/ja/FMX.Controls.Presentation.TPresentedControl.ControlType)=[Styled](http://docwiki.embarcadero.com/Libraries/Sydney/ja/FMX.Controls.TControlType) の時）。つまり OS から見ると絵が存在するだけでコントロールは存在しないので、[BN_CLICKED](https://docs.microsoft.com/ja-jp/windows/win32/controls/bn-clicked) といったコントロール用のメッセージも飛んで来ません。

通常の WM で始まるメッセージは次の方法で取得できます。

## FireMonkey でメッセージを受け取る方法
### 1.WndProc を置き換える

Win32 API の [SetWindowLong](https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlonga) を使うと、WndProc を置き換えられます。

WndProc とは、メッセージがやってくるルーチンで全ての Windows アプリケーションが持っています。

この方法の具体的な詳細は[以前の記事 FireMonkey と Windows](https://qiita.com/pik/items/b184f5ffb34576ed15dc#windows-%E3%81%AB%E4%BE%9D%E5%AD%98%E3%81%97%E3%81%9F%E5%87%A6%E7%90%86%E3%82%92%E3%81%99%E3%82%8B) を参照してください。

### 2.IFMXApplicationService を使う

[IFMXApplicationService](http://docwiki.embarcadero.com/Libraries/Sydney/ja/FMX.Platform.IFMXApplicationService) を置き換えると HandleMessage に飛んでくるメッセージを見られるようになります。

この詳細は方法は、[ht_deko さんの記事](https://qiita.com/ht_deko/items/92321a271380e64cedcf)をご覧ください。

### 3.Hook を使う

今回、説明するのはこの方法です。

Windows には Hook という仕組みがあります。
Hook とは、例えば、マウスのメッセージを監視したり、CBT (Computer Based Training) のための通知を受けたりする機構です。

この中に [WH_CALLWNDPROC](https://docs.microsoft.com/en-us/previous-versions/windows/desktop/legacy/ms644975(v=vs.85)) と [WH_GETMESSAGE](https://docs.microsoft.com/en-us/previous-versions/windows/desktop/legacy/ms644981(v=vs.85)) があります。
詳しい説明は他に譲りますが、簡単に言うとこの２つの Hook を使うと、全てのメッセージを監視できます。

#### Hook の設定

Win32 API の [SetWindowsHookEx](https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowshookexa) を使うと Hook を設定出来ます。

文字通り「全てのメッセージ」を取得する場合、Hook は DLL 内に存在する必要がありますが「アプリケーションの全てのメッセージ」であれば、普通に Hook を組み込めます。

具体的には次のように書きます。

```pascal
  FSendHook :=
    SetWindowsHookEx(WH_CALLWNDPROC, @SendHookProc, 0, GetCurrentThreadId);

  FPostHook :=
    SetWindowsHookEx(WH_GETMESSAGE, @PostHookProc, 0, GetCurrentThreadId);
```

ここで、SendHookProc, PostHookProc はそれぞれ通知を受け取る Procedure です。
また、Hook は Hook Chain を形成するので前のフックを呼び出さないといけません。そこで必要となる HHOOK 型のハンドルが SetWindowsHookEx の戻りとして帰ってきます(Hook のアンインストール時も必要)。

SendHookProc と PostHookProc は具体的には次のようになります。

```pascal
procedure PostHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM); stdcall;
begin
  // Hook が処理をして良い条件
  if (nCode > -1) and (wParam = PM_REMOVE) then
    case PMSG(lparam)^.message of
      WM_PAINT: // 何か処理
      // 他に処理したいメッセージがあれば続けて case ラベルを指定
    end;

  // 次の Hook に回す
  CallNextHookEx(TMessageDispatcherWin.FPostHook, nCode, wParam, lParam);
end;

procedure SendHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM); stdcall;
begin
  // Hook が処理をして良い条件
  if (nCode > -1) then
    case PCWPStruct(lparam)^.message of
      WM_COMMAND: // 何か処理
      // 他に処理したいメッセージがあれば続けて case ラベルを指定
    end;

  // 次の Hook に回す
  CallNextHookEx(TMessageDispatcherWin.FSendHook, nCode, wParam, lParam);
end;
```

これで、Window Message は取得できるようになりました。
次にもっと簡単にしてみたいと思います。

#### message 指令に対応する

先ほどまでだと Hook プロシージャ内でメッセージを処理していました。
ですが、Object Pascal にはせっかく message 指令があるので、これを VCL の物だけにしておくのは、もったいない！

そこで message 指令を使ったプロシージャを呼べる様にします。

#### TObject.Dispatch
[TObject.Dispatch](http://docwiki.embarcadero.com/Libraries/Sydney/ja/System.TObject.Dispatch) は Object Pascal が持っているメッセージ処理機構で、Dispatch に渡された引数の最初の 2 byte が一致する message 指令のメソッドを呼び出す機構です。

例えば、↓のような処理が可能です。

```pascal
type
  TFoo = class
  private
    proceure Bar(var Msg: TMessage); message $0001;
  end;

begin
  var Foo := TFoo.Create;
  try
    var Sample: TMessage;
    Sample.Msg := $0001; // Bar の message 指令と同じ値を指定
    Foo.Dispatch(Sample);    // これで Bar が呼ばれる
  finally
    Foo.Free;
  end;
end.
```

つまり、VCL でも出てきた message 指令は特別な何かではなく、誰でもメッセージによるメソッドの呼び出しが可能ということです。

これを使ってさっきの PostHookProc を書き換えてみると…

```pascal
procedure PostHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM); stdcall;
begin
  if (nCode > -1) and (wParam = PM_REMOVE) then
  begin
    Msg: TMessage;
    Msg.Msg := PMSG(lparam)^.message;
    Msg.wParam := PMSG(lparam)^.wParam;
    Msg.lParam := PMSG(lparam)^.lParam;
    Dispatch(Msg); // これで Msg.Msg と同じ値を指定しているメソッドを呼び出せる
  end;

  // 次の Hook に回す
  CallNextHookEx(TMessageDispatcherWin.FPostHook, nCode, wParam, lParam);
end;
```

こんな風になり、messsage 指令を使った呼び出しが出来るようになりました。

## クラス化

ここまでをクラス化して使いやすくしてみた物を gist に上げて起きました。

[PK.Utils.MessageDispatcher.Win.pas](https://gist.github.com/freeonterminate/d071026e0aaadfc079a85cab403ebead)

使い方は簡単で

```pascal
unit Unit1;

interface

uses
  System.SysUtils, FMX.Forms, FMX.Dialogs, Winapi.Messages;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  public
    // 受け取りたいメッセージを message 指令で指定
    procedure WMQuit(var AMsg: TWMQuit); message WM_QUIT;
  end;

{省略}

uses
  Winapi.Windows, PK.Utils.MessageDispatcher.Win;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // メッセージを処理するインスタンスを渡す
  TMessageDispatcherWin.RegisterHandler(Self);
end;

// WM_QUIT が来たときに呼ばれる
procedure TForm1.WMQuit(var AMsg: TWMQuit);
begin
  ShowMessage('QUIT');
end;
```

と、VCL の時と同じように message 指令を付けるのと、TMessageDispatcherWin.RegisterHandler でメッセージを処理するインスタンスを渡すだけです。

便利～！

ただ一点注意が必要で「アプリケーション全てのメッセージ」がやってくるので「誰に対して送られたメッセージか」を判別する必要があります。

幸い FMX.Platform.Win には FormToHWND という関数が定義してあるので、これで Form の Window Handle が手に入ります。
TMessageDispatcherWin にも GetWnd という現在処理中のメッセージの宛先（Window Handle）を返すメソッドがあるので誰宛なのかを確かめられます。

```pascal
procedure TForm1.WMCommand(var Msg: TWMCommand);
begin
  // 宛先が自分かどうか
  if FormToHWND(Self) = TMessageDispatcherWin.GetWnd then
  begin
    // 何か処理
  end;
end;
```

# まとめ
FireMonkey では各 OS が隠蔽されているので、少々面倒くさいですが、[PK.Utils.MessageDispatcher](https://gist.github.com/freeonterminate/d071026e0aaadfc079a85cab403ebead) を使えば簡単に処理できますね。