Windowprocs umleiten

[Flocke]

Zitat von DGL-luke:

na das ist aber ne ganz schöne redundanz, die du da hast... ein einfaches "dein oldwndproc muss von typ TWndProc sein" hätte gereicht. jetzt hab ich mindestens ne minute zum durchsteigen gebraucht...

Sorry für die verlorene Minute hab die Zeilen einfach aus einem meiner Files kopiert und nicht großartig angepasst

[Nachtrag]

Noch einmal ausführlicher: Du hast drei Varianten für das Subclassing.

Variante 1 benutzt die Eigenschaft WindowProc, die jedes TWinControl hat. Dies ist in meinen Augen die beste Variante, da sie auch funktioniert wenn sich zwischendurch das Fensterhandle sich ändert.

Delphi-Quellcode:

type
  TfrmTest = class(TForm)
    TVDataBase: TTreeView;
    procedure FormCreate(Sender: TObject);
  private
    OldTVWndProc: TWndMethod;
    procedure TVWndProc(var Msg: TMessage);
  end;

var
  frmTest: TfrmTest;

procedure TfrmTest.TVWndProc(var Msg: TMessage);
begin
  // Deine Implementierung
  // ...
  // dann:
  OldTVWndProc(Msg);
end;

procedure TfrmTest.FormCreate(Sender: TObject);
begin
  OldTVWndProc := TVDataBase.WindowProc;
  TVDataBase.WindowProc := TVWndProc;
  // sonstiger Code
end;

Variante 2 benutzt direkt die Fensterprozedur zusammen mit einer Windows WNDPROC. Das hat den Nachteil, dass du aus TVWndProc nur über Umwege (z.B. eine globale Variable) an die Daten des Formulars kommst. Außerdem ist das Subclassing weg wenn das Fensterhandle neu erzeugt wird.

Delphi-Quellcode:

type
  TfrmTest = class(TForm)
    TVDataBase: TTreeView;
    procedure FormCreate(Sender: TObject);
  private
    OldTVWndProc: FarProc;
  end;

var
  frmTest: TfrmTest;

function TVWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  // Deine Implementierung
  // ...
  // dann:
  Result := CallWindowProc(OldTVWndProc, uMsg, wParam, lParam);
end;

procedure TfrmTest.FormCreate(Sender: TObject);
begin
  OldTVWndProc := Pointer(GetWindowLong(TVDataBase.Handle, GWL_WNDPROC));
  SetWindowLong(TVDataBase.Handle, GWL_WNDPROC, LongInt(@TVWndProc));
  // sonstiger Code
end;

Variante 3 benutzt TWndMethod zusammen mit SetWindowLong/GWL_WNDPROC. Hat auch den Nachteil, dass das Subclassing weg ist wenn das Fensterhandle neu erzeugt wird.

Delphi-Quellcode:

type
  TfrmTest = class(TForm)
    TVDataBase: TTreeView;
    procedure FormCreate(Sender: TObject);
  private
    NewTVWndProc: FARPROC;
    OldTVWndProc: FARPROC;
    procedure TVWndProc(var Msg: TMessage);
  end;

var
  frmTest: TfrmTest;

procedure TfrmTest.TVWndProc(var Msg: TMessage);
begin
  // Deine Implementierung
  // ...
  // dann:
  Msg.Result := CallWindowProc(OldTVWndProc, TTreeView.Handle, Msg.Msg. Msg.wParam, Msg.lParam);
end;

procedure TfrmTest.FormCreate(Sender: TObject);
begin
  NewTVWndProc := MakeObjectInstance(TVWndProc);
  OldTVWndProc := Pointer(GetWindowLong(TVDataBase.Handle, GWL_WNDPROC));
  SetWindowLong(TVDataBase.Handle, GWL_WNDPROC, LongInt(NewTVWndProc));
  // sonstiger Code
end;

procedure TfrmTest.FormDestroy(Sender: TObject);
begin
  SetWindowLong(TVDataBase.Handle, GWL_WNDPROC, LongInt(OldTVWndProc));
  FreeObjectInstance(NewTVWndProc);
  // sonstiger Code
end;