Wywołanie funkcji zwrotnych z klasy

Spis treści

     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
 
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;
 





Kategoria: Delphi » Artykuły
Facebook
4programmers.net