DX обработка CM_MOUSELEAVE/CM_MOUSEENTER

[Bator]

Hello, All!

Как сделать один WindowProc для нескольких компонентов?
в T1proc я указываю конкретный Label1, а как узнать кто послал сообщение и
обрабатывать для него?

var Oldl1 : TWndMethod;

procedure TForm1.FormCreate(Sender: TObject);
begin
OldL1 := Label1.WindowProc;
Label1.WindowProc := L1proc;
Label1.Perform(CM_MOUSELEAVE,0,0);
end;

procedure TForm1.L1proc(var Msg: TMessage);
begin
case msg.Msg of
CM_MOUSELEAVE: begin
Label1.Color:=clBlack;
end;
CM_MOUSEENTER: begin
Label1.Color:=clred;
end;
end;
Oldl1(Msg);
end;

С уважением,
Батор
E-mail: ba...@mail.iks.ru

[Leonid Troyanovsky]

Приветствую, Bator.

Tue Feb 19 2002 16:46, Bator wrote to All:

> Как сделать один WindowProc для нескольких компонентов?
> в T1proc я указываю конкретный Label1, а как узнать кто послал сообщение и
> обрабатывать для него?

Вообще, для этого положено создавать свой контрол, который
сможет обрабатывать эти сообщения требуемым образом.

Hо, учитывая то, что контролы посылают своему Parent в параметрах
этих сообщений указатель на себя, можно сделать приблизительно так:

{Hа Form1 лежит Panel1 c произвольным количеством Label}

type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: Tlabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
private
HLControl: TControl;
OldPanelWindowProc : TWndMethod;
procedure NewPanelWindowProc(var Msg:TMessage);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.NewPanelWindowProc;

begin
case msg.Msg of
CM_MOUSELEAVE:
begin

if HLControl is TLabel then
begin
TLabel(HLControl).Font.Color := clBlack ;
HLControl := nil;
end;
end;

CM_MOUSEENTER:
begin
if msg.LParam <> 0 then
begin
HLControl := TControl(msg.LParam);
if HLControl is TLabel then
TLabel(HLControl).Font.Color := clWhite ;
end;
end;
end;
OldPanelWindowProc(Msg);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
OldPanelWindowProc := Panel1.WindowProc;
Panel1.WindowProc := NewPanelWindowProc;
end;

С уважением, LVT