Wywołanie funkcji zwrotnych z klasy
reichel
1 Wywołanie funkcji zwrotnej wykorzystując szczęśliwy zbieg okoliczności i funkcje Set/GetWindowLong
1.1 Idea
1.2 Wyłuskanie wskaźnika na obiekt
1.3 Zachowanie wskaźnika na obiekt
1.4 Kod
To na razie początek jednak wydaje mi się, że można rozwinąć ten tekst o wiele bardziej. Na razie na dobry początek opisze najbardziej prostą metodę.
Wywołanie funkcji zwrotnej wykorzystując szczęśliwy zbieg okoliczności i funkcje Set/GetWindowLong
Idea
Metoda ta polega na tym, że przekazujemy do parametru lpfnWndProc (dla funkcji RegisterClass) bezpośrednio funkcje z naszej klasy zdefiniowanej w następujący sposób ```delphi function TCallbackInClass1.WndProc( uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall; ```Czujne oko od razu zauważy brak parametru Handle
odpowiedzialnego za przekazywanie uchwytu okna do naszej funkcji zwrotnej.
Tu właśnie cały szczęśliwy zbieg okoliczności
. Standardowo w Delphi przekazywany jest też parametr Self jako pierwszy. Jest on typu pointer a zatem jego rozmiar ma 4 bajty ... podobnie jak rozmiar zmiennej przechowywującej uchwyt (integer).
Wystarczy teraz uzyskać uchwyt z powrotem (po prostu rzutować zmienną self na typ integer) i przekazać dalej (np. do funkcji DefWindowProc
).
Wyłuskanie wskaźnika na obiekt
Wydawało by się, że już wszystko jest OK. Jednak jeśli spróbujemy w naszej funkcji zwrotnej wywołać jakąś funkcje z naszej klasy lub też spróbujemy odwołać się do jakiegoś pola, niechybnie spowodujemy błąd typu AV.Na szczęście z pomocą przychodzi nam funkcja CreateWindowEx
, a dokładniej jej ostatni parametr pozwalający przesłać dodatkowe dane, które będziemy mogli wyłuskać wraz z nadejściem komunikatu WM_CREATE
. Co nam to daje? Bardzo wiele, parametr lParam
komunikatu WM_CREATE
wskazuje nam na strukturę CREATESTRUCT
, zawierającą dla nas bardzo istotny element: lpCreateParams, czyli to co przekazalicśmy do funkcji CreateWindowEx
.
Zachowanie wskaźnika na obiekt
Teraz pozostaje nam już tylko zapisać wskaźnik (bo przychodzi on tylko wraz z komunikatem `WM_CREATE`). Pytanie gdzie? Nie możemy go zapisać w jakimś polu klasy bo nie mamy do niej dostępu. Są na szczęście atrybuty okna dostępne poprzez funkcje (`GetWindowLong` oraz `SetWindowLong`) i pole najbardziej nas interesujące `GWL_USERDATA`. Teraz wystarczy w tym miejscu zapisać wskaźnik do naszego obiektu a przy następnych komunikatach pobrać go.Kod
Kod klasy:
unit CallbackInClass1;
interface
uses
Windows, Messages, SysUtils;
type
TCallbackInClass1 = class
private
FHandle, FParentHandle: HWND;
FNapis :string;
function WndProc( uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
public
function RegisterClass: Boolean;
constructor Create(hParentWnd: HWND;x,y:integer);
property Handle: HWND read FHandle;
procedure ZrobCos(a:PCHAR);
end;
implementation
//parametr self w tym przypadku bedzie traktowany jako parametr Handle (pierwszy w konwencji funkcj WNdProc
function TCallbackInClass1.WndProc( uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
rHandle:HWND;
ruMsg:UINT;
rwPar: WPARAM;
rlPar: LPARAM;
ret:integer;
begin
//wszytsko jest przesuniete o wskaznik self, do ktorego system wpisuje uchwyt okna
rHandle := integer(self);
ruMsg := uMsg;
rwPar := wPar;
rlPar := lPar;
//jesli mamy ustwaiony parametr USERDATA to pakujemy go do self inaczej powinen byc w lParam !
ret := GetWindowLong(rHandle,GWL_USERDATA);
if (ret <> 0) then
begin
self := TCallbackInClass1(ret);
end
else begin
//inaczej jest w rlPar bo mamy WM_CREATE
self := TCallbackInClass1(PCREATESTRUCT(rlPar)^.lpCreateParams);
end;
//------------------------------------------------------
//po tej czesci stosujemy takie same techniki jak w winapi oraz mozemy sie odnosci bezposredni do komponentu
case ruMsg of
WM_CREATE:
begin
//od razu po otrzymaniu komunikatu WM_CREATE zachowujemy wskaznik do this !
SetWindowLong(rHandle,GWL_USERDATA, integer(PCREATESTRUCT(rlPar)^.lpCreateParams));
end;
WM_LBUTTONDOWN:
begin
//po ustawieniu parametru self mozemy wywolac spokojnie inne funkcje
FNapis := FNapis+ ' dodatek';
ZrobCos(PChar('Bardzo prosze '+FNapis));
end;
else
Result := DefWindowProc(rHandle, ruMsg, rwPar, rlPar);
end;
end;
procedure TCallbackInClass1.ZrobCos(a:PChar);
begin
MessageBox(0,'Odwal sie',a,0);
end;
function TCallbackInClass1.RegisterClass: Boolean;
var
WndClass: TWndClass;
begin
//standardowa rejestracja okna
Result := False;
WndClass.style := CS_HREDRAW or CS_VREDRAW;
//To istotna czesc, podajemy wskaznik do funkcji w klasie.
//Klasa mam jeszcze jeden parametr, ktory przekazuje jest nim sama klasa
//rozmiar tego parametru to 4 bajty zatem tyle samo co uchwyt naszgo okna.
//Wiec po wywolaniu funkcji bedziemy musilei poszukac uchwytu naszego okna w self.
WndClass.lpfnWndProc := @TCallbackInClass1.WndProc;
WndClass.cbClsExtra := 0;
WndClass.cbWndExtra := 0;
WndClass.hInstance := hInstance;
WndClass.hIcon := 0;
WndClass.hCursor := LoadCursor(0, IDC_ARROW);
WndClass.hbrBackground := GetStockObject(BLACK_BRUSH);
WndClass.lpszMenuName := nil;
WndClass.lpszClassName := 'CallbackInClass1';
if (Windows.RegisterClass(WndClass) <> 0) then Result := True;
end;
constructor TCallbackInClass1.Create(hParentWnd: HWND;x,y:integer);
begin
inherited Create;
FParentHandle := hParentWnd;
RegisterClass;
FNapis := 'Moja pozycja to: '+IntToStr(x) +','+ IntToStr(x)+ ' ';
FHandle := CreateWindowEx(0, 'CallbackInClass1', nil, WS_CHILD or WS_VISIBLE, x, y, 100, 100, FParentHandle, 0, hInstance, self);
end;
end.
Jak wywołać:
procedure TForm1.Button1Click(Sender: TObject);
var
TLista: TCallbackInClass1;
begin
TLista := TCallbackInClass1.Create(Handle,10,10); //Utworzenie klasy
TCallbackInClass1.Create(Handle,150,10);
end;