Mega Code Archive
Using objects method as callback function
<![CDATA[
Title: Using object's method as callback function
Question: How to use objects 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 objects 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 function. If 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 FObjnil 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, 0, 12);
//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 dont process any possible errors.
]]>