DLLのコールバック関数にメソッドを使う

DelphiでDLLのコールバック関数にメソッドを使う方法。
http://code.google.com/p/python4delphi/source/browse/trunk/PythonForDelphi/Components/Sources/Core/MethodCallBack.pas
python4delphiに含まれてたMethodCallBack.pasが良い感じなので利用させていただく。
実装はアセンブラコードをごにょごにょしたりと結構複雑。やっぱりこの方法になるのかー。
まずはDLL側。単にstdcallで呼び出すだけ。Cなどで実装してもok。試したのはDelphi2009。

MyLibrary.dpr

library MyLibrary;

type
  TCallback = procedure; stdcall;

procedure DLLProc(Callback: TCallback);
begin
  Callback;
end;

exports DLLProc;

end.

次にDLLを利用するプログラム。

MyCallback.dpr

program MyCallback;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  MethodCallBack;

type
  TSayCallback = procedure of object; stdcall;
  TMyClass = class
  private
    FName: string;
    FCallbackProc: Pointer;
    procedure Say; stdcall;
  public
    constructor Create(Name: string);
    property CallbackProc: Pointer read FCallbackProc;
    property Name: string read FName write FName;
  end;

function SetCallback(f: TSayCallback): Pointer;
begin
  Result := GetOfObjectCallBack(TCallBack(f), 0, ctSTDCALL);
end;

constructor TMyClass.Create(Name: string);
begin
  FName := Name;
  FCallbackProc := SetCallback(Say);
end;

procedure TMyClass.Say;
begin
  WriteLn(FName);
end;

procedure DLLProc(Callback: Pointer); stdcall; external 'MyLibrary';

var
  obj1, obj2: TMyClass;
begin
  obj1 := TMyClass.Create('foo');
  obj2 := TMyClass.Create('bar');
  try
    DLLProc(obj1.CallbackProc);
    DLLProc(obj2.CallbackProc);
    obj1.Name := 'hoge';
    DLLProc(obj1.CallbackProc);
  finally
    obj2.Free;
    obj1.Free;
  end;
end.

実行結果

P:\Delphi\_sample\method_callback>MyCallback.exe
foo
bar
hoge

コールバックを渡すDLLのラッパークラスを書くときにかなり使えるかも。