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

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