Скачать: CL | DM;

Перехват сообщений   Найти похожие ветки 

← →
SeZuka ©   (2004-12-08 10:59) [0]

Мастера, подскажите. Пишу свой компонент, который должен следить за визуальными компонентами на форме, т.е. перехватывать события типа изменения их состояния, положения и размеров. Как это сделать?

---

← →
Игорь Шевченко ©   (2004-12-08 11:03) [1]

Например, так:

unit HSControlMessagePumpHook;

interface
uses
 HSObjectList, Controls, Messages;

type
 THSControlMessagePumpHook = class
 private
   FControl : TControl;
   FOldWndProc : TWndMethod;
   procedure HookWndProc (var Message : TMessage);
 public
   constructor Create (AControl : TControl);
 end;

 THSControlMessagePumpHookList = class(THSObjectList)
 end;

const EnableMsgHook = true;

implementation
uses
 Windows, SysUtils, MessageLogger;

{ THSControlMessagePumpHook }

constructor THSControlMessagePumpHook.Create(AControl: TControl);
begin
 FControl := AControl;
 FOldWndProc := FControl.WindowProc;
 FControl.WindowProc := HookWndProc;
end;

procedure THSControlMessagePumpHook.HookWndProc(var Message: TMessage);
begin
 if Assigned(FControl) and (FControl IS TWinControl) and
    TWinControl(FControl).HandleAllocated then
   LogMessage(Format("%s.WndProc", [FControl.Name]),
              TWinControl(FControl).Handle, Message.Msg,
              Message.WParam, Message.LParam)
 else
   LogMessage(Format("%s.WndProc", [FControl.Name]),
              0, Message.Msg,
              Message.WParam, Message.LParam);
 FOldWndProc(Message);
 LogMsgReturn(Format("%s.WndProc", [FControl.Name]), Message);
end;

end.


И в нужной форме я перекрываю метод .Loaded


type
 TForm1 = class(TForm)
....
 protected
   procedure Loaded; override;
....
 end;

.....

procedure TForm1.Loaded;
var
 I: Integer;
begin
 inherited;
 if EnableMsgHook then begin
   FHooks := THSControlMessagePumpHookList.Create;
   FHooks.Add(THSControlMessagePumpHook.Create(Self));
   for I:=0 to Pred(ComponentCount) do
     if Components[I] is TControl then
       FHooks.Add(THSControlMessagePumpHook.Create(TControl(Components[I])));
 end;
end;
/CODE>

С уважением,

---

← →
SeZuka ©   (2004-12-08 11:19) [2]

2 Игорь Шевченко ©   (08.12.04 11:03) [1]
Спасибо! Буду пробовать.

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.098 c