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

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