Thema: Delphi WndProc, WindowProc

Einzelnen Beitrag anzeigen

jbg

Registriert seit: 12. Jun 2002
3.483 Beiträge
 
Delphi 10.1 Berlin Professional
 
#2
  Alt 22. Okt 2002, 11:30
Da muss ich dich enttäuschen. Das geht nicht so einfach. Du hast 2 logische Fehler in deinem Code.

1. Du hast vergessen den vorherigen Wert von WindowProc zu sichern. Mit diesem Wert hättest du die Möglichkeit die "alte" WindowProc aufzurufen, die nicht unbeding auf WndProc zeigen muss.

2. Mit dem inherited WndProc rufst du für jedes Control die WndProc von TForm auf und nicht die des entsprechenden Controls.

Hier hast du eine Unit, die dir die Arbeit abnimmt.
Code:
[b]unit[/b] WndProcHooks;
[b]interface[/b]
[b]uses[/b] Windows, Messages, SysUtils, Classes, Controls;
[b]type[/b]
  TWndMethodEx = [b]procedure[/b](Control: TControl; [b]var[/b] [b]Message[/b]: TMessage;
    OrgWndProc: TWndMethod) [b]of[/b] [b]object[/b];

  PWndProcRec = ^TWndProcRec;
  TWndProcRec = [b]record[/b]
    OrgWndProc: TWndMethod;
    NewWndProc: TWndMethodEx;
    Control: TControl;
  [b]end[/b];

  TWndProcList = [b]class[/b](TList)
  [b]private[/b]
    [b]function[/b] GetIndex(Control: TControl): Integer;
  [b]protected[/b]
    [b]procedure[/b] TransferWndProc([b]var[/b] [b]Message[/b]: TMessage); [b]virtual[/b];
  [b]public[/b]
    [b]procedure[/b] HookControl(Control: TControl; NewWndProc: TWndMethodEx);
    [b]procedure[/b] UnhookControl(Control: TControl);
    [b]function[/b] FindOrgWndProc(Control: TControl): TWndMethod;

    [b]procedure[/b] ClearFromOwner(AOwner: TComponent);
    [b]procedure[/b] Clear; [b]override[/b];
  [b]end[/b];

[b]var[/b]
  WndProcList: TWndProcList;

[b]implementation[/b]

[b]type[/b]
  TWndMethodRec = [b]record[/b]
    Code: Pointer;
    Obj: TObject;
  [b]end[/b];

[b]function[/b] TWndProcList.GetIndex(Control: TControl): Integer;
[b]begin[/b]
  [b]for[/b] Result := 0 [b]to[/b] Count - 1 [b]do[/b]
    [b]if[/b] PWndProcRec(Items[Result])^.Control = Control [b]then[/b]
      Exit;
  Result := -1;
[b]end[/b];

[b]procedure[/b] TWndProcList.HookControl(Control: TControl; NewWndProc: TWndMethodEx);
[b]var[/b]
  P: PWndProcRec;
  Proc: TWndMethod;
[b]begin[/b]
  New(P);
  P^.Control := Control;
  P^.OrgWndProc := Control.WindowProc;
  P^.NewWndProc := NewWndProc;
  Add(P);

  Proc := TransferWndProc;
  TWndMethodRec(Proc).Obj := Control;
  Control.WindowProc := Proc;
[b]end[/b];

[b]procedure[/b] TWndProcList.UnhookControl(Control: TControl);
[b]var[/b]
  Index: Integer;
  P: PWndProcRec;
[b]begin[/b]
  Index := GetIndex(Control);
  [b]if[/b] Index <> -1 [b]then[/b]
  [b]begin[/b]
    P := PWndProcRec(Items[Index]);
    Control.WindowProc := P^.OrgWndProc;
    Dispose(P);
    Delete(Index);
  [b]end[/b];
[b]end[/b];

[b]function[/b] TWndProcList.FindOrgWndProc(Control: TControl): TWndMethod;
[b]var[/b] Index: Integer;
[b]begin[/b]
  Index := GetIndex(Control);
  [b]if[/b] Index <> -1 [b]then[/b] Result := PWndProcRec(Items[Index])^.OrgWndProc;
[b]end[/b];

[b]procedure[/b] TWndProcList.ClearFromOwner(AOwner: TComponent);
[b]var[/b]
  Index: Integer;
  P: PWndProcRec;
[b]begin[/b]
  [b]for[/b] Index := Count - 1 [b]downto[/b] 0 [b]do[/b]
  [b]begin[/b]
    P := PWndProcRec(Items[Index]);
    [b]if[/b] P^.Control.Owner = AOwner [b]then[/b]
    [b]begin[/b]
      P^.Control.WindowProc := P^.OrgWndProc;
      Dispose(P);
      Delete(Index);
    [b]end[/b];
  [b]end[/b];
[b]end[/b];

[b]procedure[/b] TWndProcList.Clear;
[b]var[/b]
  Index: Integer;
  P: PWndProcRec;
[b]begin[/b]
  [b]for[/b] Index := 0 [b]to[/b] Count - 1 [b]do[/b]
  [b]begin[/b]
    P := PWndProcRec(Items[Index]);
    P^.Control.WindowProc := P^.OrgWndProc;
    Dispose(P);
  [b]end[/b];
  [b]inherited[/b] Clear;
[b]end[/b];

[b]procedure[/b] TWndProcList.TransferWndProc([b]var[/b] [b]Message[/b]: TMessage);
[b]var[/b]
  i: Integer;
  P: PWndProcRec;
  OrgWndProc: TWndMethod;
[b]begin[/b]
  [color=#000080][i]// Self zeigt auf das Control[/i][/color]
  i := WndProcList.GetIndex(TControl(Self));
  [b]if[/b] i <> -1 [b]then[/b]
  [b]begin[/b]
    P := PWndProcRec(WndProcList.Items[i]);
    OrgWndProc := P^.OrgWndProc;
    [b]if[/b] ([b]Message[/b].Msg = WM_DESTROY) [b]or[/b] (csDestroying [b]in[/b] P^.Control.ComponentState) [b]then[/b]
    [b]begin[/b]
      WndProcList.UnhookControl(P^.Control);
      OrgWndProc([b]Message[/b]);
    [b]end[/b]
    [b]else[/b]
      P^.NewWndProc(P^.Control, [b]Message[/b], OrgWndProc);
  [b]end[/b];
[b]end[/b];

[b]initialization[/b]
  WndProcList := TWndProcList.Create;

[b]finalization[/b]
  WndProcList.Free;

[b]end[/b].

Und hier die Verwendung der Unit:
Code:
[b]procedure[/b] TForm1.ISWndProc(Control: TControl; [b]var[/b] [b]Message[/b]: TMessage;
  OrgWndProc: TWndMethod);
[b]begin[/b]
  [b]with[/b] [b]Message[/b] [b]do[/b]
  [b]begin[/b]
   [b]if[/b] (msg=WM_LBUTTONDOWN)
    [b]or[/b] (msg=WM_LBUTTONUP)
    [b]or[/b] (msg=WM_LBUTTONDBLCLK)
    [b]or[/b] (msg=WM_RBUTTONDOWN)
    [b]or[/b] (msg=WM_RBUTTONUP)
    [b]or[/b] (msg=WM_RBUTTONDBLCLK)
   [b]then[/b]
   [b]begin[/b]
    WMessage.msg:=[b]Message[/b];

    bNewMessage:=true;
   [b]end[/b];
  [b]end[/b];
  OrgWndProc([b]Message[/b]);
[b]end[/b];

[b]procedure[/b] TForm1.FormCreate(Sender: TObject);
[b]var[/b] Index: integer;
[b]begin[/b]
  [b]for[/b] Index := 0 [b]to[/b] ControlCount - 1 [b]do[/b]
    WndProcList.HookControl(Controls[Index], ISWndProc);
[b]end[/b];

[b]procedure[/b] TForm1.FormDestroy(Sender: TObject);
[b]begin[/b]
  WndProcList.ClearFromOwner(Self);
[b]end[/b];
  Mit Zitat antworten Zitat