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? :gruebel:

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 :gruebel:

***

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! :warn:

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. :angle2:

[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. :thumb:

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).

[himitsu]

Jupp, dort würde dein Win32 Programm ja in einem "virtuellen" 32 Bit-Windows ausgeführt.


Wenn man irre ist, dann kann man auch die möglichkeiten der Klassen ausnutzen.

Di kennst ja bestimmt das Folgendes

Delphi-Quellcode:

procedure WMGestureNotify(var Message: TWMGestureNotify); message WM_GESTURENOTIFY;
procedure CMActivate(var Message: TCMActivate); message CM_ACTIVATE;
procedure WndProc(var Message: TMessage); override;

Würde dann wohl etwa so aussehn ... natürlich in Assembler, da ja das SELF hardcodiert sein müßte.

Delphi-Quellcode:

//type
//  TMessage = packed record
//    Msg: Cardinal;
//    WParam: WPARAM;
//    LParam: LPARAM;
//    Result: LRESULT;
//  end;

function WndProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  Message: TMessage;
begin
  Message.Msg    := Msg;
  Message.WParam := wParam;
  Message.LParam := lParam;
  Message.Result := 0;
  TheDispatcher.Dispatch(Message);
  Result := Message.Result;
end;

statt deinem globalen Array könnte man auch gleich alles in diese Klasse verbauen:

Delphi-Quellcode:

type 
  TDispatcher = class
  private
    FHandle: HWND;
    FMessage: TMessage;
    FWndProcInfo: TWndProcInfo;
  public
    constructor Create(Window: HWND);
    destructor Destroy;

    property Handle: HWND read FHandle;
  end;

function WndProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  with TheDispatcher do begin
    FHandle         := Wnd;    // (MethodOwner +  8)^ := Wnd; (sollte +8 sein ... glaub ich)
    FMessage.Msg    := Msg;    // (MethodOwner + 12)^ := Msg;
    FMessage.WParam := wParam; // (MethodOwner + 16)^ := wParam
    FMessage.LParam := lParam; // (MethodOwner + 20)^ := lParam;
    FMessage.Result := 0;      // (MethodOwner + 24)^ := 0;
    Dispatch(Message);         // call TObject.Dispatch mit TheDispatcher und MethodOwner als Parameter
    Result := FMessage.Result; // Result := (MethodOwner + 24)^;
  end;
end;

PS: Statt das Self hardzukodieren kannste es uch über SetProp an das Fenster hängen und über GetProp auslesen ... dann könnteste deine deine Proceduren in Pascal schreiben.
Wäre ja nur noch eine Variante nötig wäre, da man keine Werte hardcodiert hätte.

Hat auch den Vorteil, daß man schauen kann kann, ob schon soein Hook an dem Fenster hängt. (PS: so macht es die VCL ... die hängt ihr Self auch einfach überall an)
Es gäbe zwar noch GWL_USERDATA, aber das wäre wohl zu unsicher, da es ja schon belegt sein kann.

Delphi-Quellcode:

SetProp(hWnd, 'Satty67_Dispatcher', THandle(TheDispatcher));

Ach ja, ich hatte

Delphi-Quellcode:

FHandle := Wnd

immer wieder neu gesetzt .. das könnte man auch nicht machen
- wenn die Klasse nur an einem Fenster hängt, dann ändert sich dieses nicht
- wenn man es veränderbar macht, könnte man mehere Fenster an eine Klasse hängen


[add]
ich seh grade, daß man man bei dem Dispatch ebenfalls nur das SELF zwischen das HWND und MSG schieben müßte, dann bräuchte man das Message nicht kopieren, sondern könnte direkt auf den Stack zeigen und kopiert nach Prozeduraufruf noch nur noh das Result in EAX.

[Satty67]

Ist immer wieder erstaunlich, wie man ich ständig auf völlig neue unerforschte Bereiche in Delphi stosse. Hatte mich bisher immer aufs Framework verlassen ;)

Ich splitte das ganze in zwei Aufgaben auf:

1) Die Unit mit dem WindowProc-Hook, die möglichst wenig "am Fenster" ändern darf, falls es ein fremdes Fenster ist. Deshalb hat mir die Lösung aus der VCL etwas Sorgen gemacht. Da fehlen noch ein paar Funktionen, um die alte WndProc aufzurufen... und das x64 Promblem hatte ich ja anfangs garnicht im Hinterkopf.

2) Auf die Idee einer eigenen Fensterklasse bin ich gekommen, weil es für den TAppButton wesentlich besser funktioniert, als ein TForm mit all dem Balast zu nehmen. Das soll ja später eine Komponente werden. Da werfe ich die Lösung mit dem x86 Dispatcher wieder raus und implementiere eine Variante, die nur für die Komponente übersetzt. Da besteht ja zum Glück der Sonderfall, das pro Application nur eine Instanz benötigt wird und ich keinen Verteiler für die WindowProc brauche.

Ich geh' mal Brötchen holen, kann im Moment fast nur am WE programmieren. Brauche Kohlehydrate fürs Gehirn... das ganze ist leider nicht so banal, wie ich erst gedacht hatte ;)