Callback WndProc innerhalb einer Klassen-Methode... ist das OK?

[Satty67]

Hallo,

in einer Klasse möchte ich u.a. ein NonVCL Fenster anzeigen (also RegisterClassEx/CreateWindowEx).

Es gibt ja das bekannte Problem, dass als WndProc keine Methonde direkt angegeben werden kann (self Parameter). Hier im Forum gibt es auch mind. zwei Lösungen für das Problem. Ich habe jetzt eine etwas andere gefunden, die auf den ersten Blick funktioniert. Bin mir aber nicht sicher, ob ich evtl. ein Problem damit übersehe.

Aufs wesentliche gekürzt, sieht das jetzt so aus:

Delphi-Quellcode:

procedure TXYZClass.RegisterWindowClass;

  function _WndProc(hWnd: HWND; uMsg: UINT;
                          wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  var
    Message : TMessage;
    Handled : Boolean;
  begin
    Message.Msg := uMsg;
    Message.WParam := wParam;
    Message.LParam := lParam;
    self.WndProc(Message, Handled);
    if Handled then
      Result := 0
    else
      Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;

var
  WCE: TWndClassEx;
begin
  WCE.lpszClassName := 'TXYZWindowClass';
  [...]
  WCE.lpfnWndProc :=  @_WndProc;
  RegisterClassEx(WCE);
end;

procedure TXYZClass.WndProc(const Message: TMessage; var Handled: Boolean);
begin
  Handled := False;
  if Message.Msg = WM_LBUTTONDOWN then
  begin
    ShowMessage('Left Mousebutton down.');
    Handled := True;
  end;
end;

PS: Dass das Fenster unbedingt vor der Klasse zerstört sein muss, ist soweit klar.

[himitsu]

Nein.

Grund, die Signatur dieser Methode stimmt nicht mit den benötigten Parametern überein.
Genauso wie normale Methoden hat auch diese (mindestens) einen weiteren versteckten Parameter.


Tipp: Versuch einfach mal deine Methode dieser Variable zuzuweisen ... sollte nicht gehn.

Delphi-Quellcode:

type TWndProc = function(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var MyWndProc: TWndProc;

MyWndProc := WndProc;

Bei solchen Pointerssachen muß man halt aufpassen, da dort Delphi die Signaturen nicht prüfen kann.


Du kannst diese Methode aber dennoch in deine Klasse auslagern.

Delphi-Quellcode:

type
  TXYZClass = class(...)
    class function _WndProc(hWnd: HWND; uMsg: UINT;
      wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; static;
  end;

static ist hier das Zauberwort, denn diese statischen Klassenmethoden haben keinen versteckten Parameter.

Es gibt zwar auch noch trickt, wie man eine "normale" Methode so vergiben kann, daß am Ende in Self dein HWND versteckt wäre (also stattdessen), aber ich würde nicht unbvedingt dazu raten.

[Satty67]

Hallo himitsu,

schau doch bitte nochmal genau hin, was ich mache
Die Methode wird ja gar nicht als Callback-Funktion angegeben.

€: Hmm... sehe gerade, dass Du darauf eingehst...

Ich hatte gehofft, das die Funktion in der Methode wie eine Funktion ausserhalb behandelt wird. Das Handle (also der erste Parameter) stimmt auf jeden Fall. Es scheint also zumindest kein versteckter self-Parameter davor zu liegen.

Oder anders ausgedrückt:

Ich hatte gehofft, dass das verwendete self. in der Funktion _WndProc nicht durch einen versteckten Parameter kommt, sondern von der umschließenden Methode bereitgestellt wird.

[himitsu]

Irgendwo muß aber was übergeben werden, denn wie wäre sonst sowas möglich?

Delphi-Quellcode:

procedure TMyClass.Irgendwas(Hallo: String);
var 
  Welt: String;
procedure Sagen(Etwas: String);
  begin
    ShowMessage(Hallo + Welt + Etwas);
  end;
begin
  Welt := ' World';
  Sagen('!!!')
end;

Irgendwas('Hello');

[Satty67]

Eine statische Methode wäre natürlich sehr elegant.

Leider bekomme ich die auch gerade nicht in eine Variable geklopft oder direkt zugewiesen. Ob es an D2007 liegt... oder eher an mir... ich probiere mal noch etwas rum.

***

Sieht das so besser aus?

Delphi-Quellcode:

type
  TWndProc = function(hWnd: HWND; uMsg: UINT;
                      wParam: WPARAM; lParam: LPARAM): LRESULT of object; stdcall;

  TNonVCLWin = class
  [...]
  protected
    class function _WndProc(hWnd: HWND; uMsg: UINT;
         wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; static;
  [...]
  end;

implementation

{ TNonVCLWin }
constructor TNonVCLWin.Create(MainForm: TCustomForm);
begin
  [...]
  RegisterWindowClass(_WndProc);
end;

class function TNonVCLWin._WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT;
begin
  Result := 0;
  case uMsg of
    WM_LBUTTONDOWN:
        MessageBox(hwnd, 'Mouse Button Down', 'Message', 0);
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;

end;

procedure TNonVCLWin.RegisterWindowClass(AWndProc: TWndProc);
var
  WCE: TWndClassEx;
begin
  [...]
  WCE.lpfnWndProc :=  @AWndProc;
  RegisterClassEx(WCE);
end;

Es funktioniert beides, also auch mein Versuch aus dem ersten Post. Dein Vorschlag mit der statischen Mwethode ist natürlich erheblich schöner, da ich nicht von hinten durch die Brust ins Auge muss.

PS: Die statische Methode dann auch besser gleich in den private Abschnitt schieben?

PPS. Ach halt... mit der class function kann ich ja nicht auf die Member der Klasse zugreifen

***

Sooo... eben beim weiter probieren gemerkt, das ich bei beiden Varianten nicht auf Member der Klasse zugreifen kann. Bei der class function fehlt der Verweis, bei meiner Variante scheint der self. Verweis tatsächlich auf einen falschen Speicherbereich zu zeigen. Funktioniert nur "scheinbar", solange ich lokal inerhalb der Funktion bleibe.

Schade... muss wohl doch einen der anderen (hier im Forum kreisenden) Wege gehen.

[Satty67]

Wie zu erwarten war (zumindest nachdem was ich jetzt weis), hab' ich keine elegante (direkte) Lösung gefunden.

Recht gut gefallen hat mir der TCallDispatcher von negaH. Da ich fürs aktuelle Fenster nur eine Instanz brauche, konnte ich das auch direckt in der Klasse implementieren.

Um auch mehrere Instanzen verwenden zu können, hab' ich mir was gebastelt (noch unvollständig und nur zum Testen!). Da das aber auch wieder etwas vom vorgeschlagenen Weg (in den gefundenen Threads) abweicht, poste ich das mal.

Wenn ich wieder etwas übersehen habe, könnt Ihr mir ja auf die Finger hauen

Interessant ist im Prinzip nur RegisterMethod()

Delphi-Quellcode:

// *******************************************************************
// Hook a WindowProc to a TObject.Method
//
// CallDispatcher/-Init by negaH @ delphipraxis.net
//
// *******************************************************************
unit uWndProcDispatcher;

interface

uses
  Windows, Messages;

type
  TWndProc = function (Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  TWndProcMethod = function (Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT of object; stdcall;

// Empty WindowProc
function DefaultWndProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
// Hook the WindowProc and dispatch for a TObject.Method
function RegisterMethod(Wnd: HWND; MethodOwner: TObject; WndProcMethod: TWndProcMethod): Boolean;
// UnHook the WindowProc
function ReleaseMethod(Wnd: HWND): Boolean;

implementation

type
  TCallDispatcher = packed record
    POP_EAX: Byte;
    PUSH_CONST: Byte;
    Self: Pointer;
    PUSH_EAX: Byte;
    JMP_RELATIVE: Byte;
    Offset: Integer;
  end;

  TWndProcInfo = packed record
    Handle : HWND;
    Method : TWndProcMethod;
    Owner : TObject;
    OldWndProc : TWndProc;
    Dispatcher : TCallDispatcher;
  end;
  TWndProcInfos = array of TWndProcInfo;

var
  WndProcInfos : TWndProcInfos;

// *******************************************************************
function DefaultWndProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  Result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;

// *******************************************************************
function RegisterMethod(Wnd: HWND; MethodOwner: TObject; WndProcMethod: TWndProcMethod): Boolean;
var
  i : Integer;
begin
  ReleaseMethod(Wnd);
  i := Length(WndProcInfos);
  SetLength(WndProcInfos, i + 1);
  with WndProcInfos[i] do
  begin
    Dispatcher.POP_EAX := $58;
    Dispatcher.PUSH_CONST := $68;
    Dispatcher.Self := MethodOwner;
    Dispatcher.PUSH_EAX := $50;
    Dispatcher.JMP_RELATIVE := $E9;
    Dispatcher.Offset := PChar(@WndProcMethod) - PChar(@Dispatcher) - SizeOf(Dispatcher);
    Handle := Wnd;
    Method := WndProcMethod;
    Owner := MethodOwner;
    OldWndProc := TWndProc(Pointer(GetWindowLong(Wnd, GWL_WNDPROC)));
    Result := SetWindowLong(Wnd, GWL_WNDPROC, LongInt(@Dispatcher)) <> 0;
  end;
end;

// *******************************************************************
procedure DeleteWndProcInfo(Index: Integer);
var
  Count : Integer;
begin
  Count := Length(WndProcInfos);
  if (Index >= 0) and (Index < Count) then
  begin
    if Count > 1 then
      WndProcInfos[Index] := WndProcInfos[Count -1];
    SetLength(WndProcInfos, Count -1);
  end;
end;

// *******************************************************************
function ReleaseMethod(Wnd: HWND): Boolean;
var
  i : Integer;
begin
  Result := False;
  for i := Low(WndProcInfos) to High(WndProcInfos) do
  begin
    if (WndProcInfos[i].Handle = Wnd)
    and (@WndProcInfos[i].OldWndProc <> nil) then
    begin
      SetWindowLong(Wnd, GWL_WNDPROC, LongInt(@WndProcInfos[i].OldWndProc));
      DeleteWndProcInfo(i);
      Result := True;
      Break;
    end;
  end;
end;

end.

[himitsu]

Den MethodOwner kannst du weglassen, da dieser in WndProcMethod schon mit drin steckt.

Eine Methodenzeiger ist "zwei Zeiger" in einem (Self und der Prozedurzeiger)
Caste einfach den Methodenzeiger mit TMethod, aus der Unit System.



Nicht mit PChar casten und dann damit rechnen!

PChar nutzt eine Arithmetic mit SizeOf(Char), also ab Delphi 2009 ist PChar(i)+1 = PAnsiChar(i)+2 = P + 2 Byte
Entweder mit NativeInt (eigentlich NativeUInt) oder eben mit PAnsiChar arbeiten, oder etwas anderem, für welches eine byteweise Pointerarithmetic verbaut ist.

Und Pointer mit einem LongInt zu casten ist auch keine so gute Idee, in Zeiten eines 64-Bit-Delphis.

[Satty67]

Ok, zwei gute Vorschläge. Der Dispatcher ist von 2003 und war allgemein gehalten, passe das gerade erst langsam an.

Da ich ja statt dem Pointer eine Methode fordere, kann ich mir tatsächlich den OwnerObject-Parameter sparen.

Die casts passe ich auch noch alle an, da hat 2003 noch niemand dran gedacht und ich auch 2011 nicht, mit meinem D2007

Danke erst mal dafür...

PS:

Hmmm, unter 64bit muss dann gleich komplett SetWindowLong() ersetzt werden? Der Parameter bleibt ja Long und somit 32bit?
OK, gefunden, muss SetWindowLongPtr() nehmen.

[himitsu]

Nja, bei 64 Bit muß man eh einen alternativen TCallDispatcher anbieten, da dort die Register anders genutzt werden und es auch ganz andere Register gibt (abgesehn von der Registergröße)

Wie das da genau aussieht, kann ich jetzt aber auch nicht beantworten.

[Satty67]

...ich vermerke das alles mal als ToDo's in der Unit.

Zumindest solange ich unter D2007 compiliere, sollte es aber auch unter Win x64 funktionieren. Für eine vollständige Anpassung brauche ich dann wohl XE2+ und ein x64 System (zumindest wenn ich es selber testen will).