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