イベントハンドラを無名メソッドで書く。

2ヶ月ちょっとくらい放置だったのはこの際忘れるとして。

C#では次のように無名のイベントハンドラを記述できるので、

wahaa.Click += delegate { MessageBox.Show("わはー"); };

Delphiに無名メソッドが実装された時、きっとできるんだろうと甘く考えてたら全然できなかった。
なのでできるようにしてみた。

// 謎のコード
function MakeHandler(const Proc: IInterface): TMethod;
begin
  Result.Data := PPointer(@Proc)^;
  Result.Code := PPointer(PByte(PPointer(PPointer(@Proc)^)^)+$C)^;
end;

// 使い方
procedure TForm1.Button1Click(Sender: TObject);
begin
  OnMouseMove := TMouseMoveEvent(MakeHandler(IInterface(
    procedure(Sender: TObject; Shift: TShiftState; X, Y: Integer)
    begin
      Form1.Caption := Format('%d,%d', [X, Y]);
    end)));
end;

謎のコードはパッと見ると本当に謎のコードなんだけど、2行目（Result.Code...）を分解して考えると、

var
  p: Pointer;
begin
  p := PPointer(@Proc)^; // Pointer(Proc)ができないので、変数アドレスから逆参照してProcアドレスを取得
                         // ただし正確に言えばこれはProcの関数アドレスではなく、暗黙のオブジェクトを指すアドレス
  p := PPointer(p)^;     // さらに逆参照して関数テーブルのアドレスを取得
  p := PByte(p)+$C;      // 暗黙のオブジェクトはIInterfaceにInvokeがついたものなのを実装していて、
                         // QueryInterfaceを+0、_AddRefを+4といったように計算するとInvokeの位置は+C
  p := PPointer(p)^;     // テーブル内の位置が分かったので、さらに逆参照して関数アドレスを得る
  Result.Code := p;
end;

こんな風になってて、要するに暗黙のオブジェクトのインスタンスから実際のメソッドアドレスを取得して既存のイベントハンドラ構造に入れてやれば動くんじゃね的な。IInterfaceは何となく。何らかの型にキャストしないといけないので、別にそこはTProcとかでも良かった。

ちなみにDataはnilでもOK。DataはSelfにあたるんだけど、無名メソッド内で暗黙のオブジェクトのSelfに触るコードは普通にやったら書けないので。ただ、実際に書いてみるとSelfは普通に使えるじゃねーかコノヤローとか言われそうだけど、今回の例で言えばこのSelfはTForm1のインスタンスを指すSelfなので別物でございます。さらにそれなりにトリッキーなことをしてるので、このSelfに触ると実行時に怒られちゃう。上記のようにSelfの代わりにForm1変数を使うか、どうしてもSelfを使いたい場合はクロージャにしてSelfを束縛しておけばおｋだと思う。

あとは、このままじゃキャストがうざいし安全でもないので、よく使うであろうイベント(TNotifyEventとか)に絞って、以下のようにしてしまった方が何かといいと思う。

type
  TNotifyEventProc = reference to procedure(Sender: TObject);

// MakeHandlerをTNotifyEvent専用にしたもの
function MakeNotifyEventHandler(const Proc: TNotifyEventProc): TNotifyEvent;
var
  method: TMethod;
begin
  method.Data := PPointer(@Proc)^;
  method.Code := PPointer(PByte(PPointer(PPointer(@Proc)^)^)+$C)^;
  Result := TNotifyEvent(method);
end;

// 使い方
procedure TForm1.Button1Click(Sender: TObject);
begin
  // すごくすっきり！
  OnClick := MakeNotifyEventHandler(
    procedure(Sender: TObject)
    begin
      ShowMessage('わはー');
    end);
end;

追記

MakeHandlerの方はジェネリック使えば多少マシになるかと思ってクラスメソッドにしてみたけど、大して変わんなかった。

// MakeHandlerの代替物
type
  TEventHandler<T> = class
  public
    class function Wrap(const Proc: IInterface): T;
  end;

class function TEventHandler<T>.Wrap(const Proc: IInterface): T;
var
  ti: PTypeInfo;
  method: TMethod;
begin
  ti := TypeInfo(T);
  if ti^.Kind <> tkMethod then
    raise Exception.Create('型引数にはメソッドポインタのみ指定できるよ！');
  method.Data := PPointer(@Proc)^;
  method.Code := PPointer(PByte(PPointer(PPointer(@Proc)^)^)+$C)^;
  Move(method, Result, SizeOf(method));
end;

// 使い方
procedure TForm1.Button1Click(Sender: TObject);
begin
  OnClick := TEventHandler<TNotifyEvent>.Wrap(IInterface(
    procedure(Sender: TObject)
    begin
      ShowMessage('わはー');
    end));
end;

追記の追記

TMethod.Dataをnilにしていいのは親のローカル変数に触ってない場合なので*1、普通は上記コードのまま使用した方が無難。
さらに言えば、無名メソッドの参照カウンタを全く考慮してないので、親のローカル変数に触ったら死ぬかも。使うのはShowMessageするだけとか、グローバル変数にしかアクセスしないような簡単な内容に限った方がいいかも*2。

*1:簡単に言えばこのローカル変数は暗黙に作られるクラスのメンバ変数という扱いになるので

*2:もしくは突如としてこの問題を解決するアイデアを思いつくハンサムなポルナレフ的誰かが現れるのを期待