API - como usar um metodo como funcao de callback

Top  Previous  Next

Question/Problem/Abstract:

==========================

 

How to use object’s method as callback function

 

Answer:

======

Some times it is more convenient to use member function as callback function. You can refer to properties of the particular object without obtaining of its reference. But just this improvement disables you to use simple syntax, like following: 

TMyFunc = function (Wnd: HWND; Msg: Cardinal; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 

… 

//This function is NOT object’s method, it is regular function. 

MyFunction(Wnd: HWND; Msg: Cardinal; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 

begin 

  //Do something 

end

… 

p:=MyFunction; //p: TMyFunc 

SetWindowLong(Handle, GWL_WNDPROC, Carpinal(@p)); 

… 

This code will proper work because MyFunction is not member functionIf you try to use such approach to member function you could not get correct formal parameters assignment inside one. 

Instead that you could use code shown below. The core of this simple is creating “run-time” function and passing its address as pointer to call back function

type 

  TMyFunc = function (Wnd: HWND; Msg: Cardinal; wParam: WPARAM; lParam: LPARAM): LRESULT of object; stdcall; 

  TA = class 

  private 

    FAddress: Pointer; 

    FOldFunc: Cardinal; 

    FParent: TWinControl; 

    function MyFunction(Wnd: HWND; Msg: Cardinal; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 

  public 

    constructor Create(AParent: TWinControl); 

    destructor Destroy; override; 

  end

 

  TForm1 = class(TForm) 

    Button1: TButton; 

    procedure Button1Click(Sender: TObject); 

    procedure FormClose(Sender: TObject; var Action: TCloseAction); 

  private 

    { Private declarations } 

    FObj:TA; 

  public 

    { Public declarations } 

  end

 

var 

  Form1: TForm1; 

 

implementation 

 

{$R *.DFM} 

 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

  FObj:=TA.Create(Self); 

end

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 

begin 

  if FObj<>nil then FObj.Free; 

end

 

{ TA } 

 

constructor TA.Create(AParent: TWinControl); 

var 

  p: TMyFunc; 

begin 

  inherited Create

  FParent := AParent; 

  FOldFunc:=GetWindowLong(AParent.Handle, GWL_WNDPROC); 

//Alloc buffer for “run-time” function 

  FAddress := HeapAlloc(GetProcessHeap, 012); 

//Now fill buffer with following commands: 

//pop EAX            ($58) 

//push Self          ($68xxxxxxxx) 

//push EAX           ($50) 

//jmp TA.MyFunction  ($E9xxxxxxxx) 

  PWORD(FAddress)^:=$6858

  PDWORD(Cardinal(FAddress)+2)^:=Cardinal(Self); 

  PWORD(Cardinal(FAddress)+6)^:=$E950

  p:=MyFunction; 

  PDWORD(Cardinal(FAddress)+8)^:=Cardinal(@p)-Cardinal(FAddress)-12

(*  or more sophisticated 

asm 

    mov  EAX, Self 

    mov  ECX, [EAX].FAddress 

 

    mov  word  ptr [ECX+0], $6858               

    mov  dword ptr [ECX+2], EAX 

    mov  word  ptr [ECX+6], $E950 

    mov  EAX, OFFSET(MyFunction) 

    sub  EAX, ECX 

    sub  EAX, 12 

    mov  dword ptr [ECX+8], EAX 

  end;(**) 

  SetWindowLong(FParent.Handle, GWL_WNDPROC, Cardinal(FAddress)); 

end

 

destructor TA.Destroy; 

begin 

  SetWindowLong(FParent.Handle, GWL_WNDPROC, FOldFunc); 

//Free buffer 

  HeapFree(GetProcessHeap, 0, FAddress); 

  inherited; 

end

 

function TA.MyFunction(Wnd: HWND; Msg: Cardinal; wParam: WPARAM; 

  lParam: LPARAM): LRESULT; 

begin 

  //Here you can do some thing before default processing take place. 

  //… 

  Result:=CallWindowProc(Pointer(FOldFunc), Wnd, Msg, wParam, lParam); 

end

 

end

 

You have to improve code above before using in application. It only show principle and don’t process any possible errors.