Отслеживать переход мышки на компонент и уход ее

Отслеживать переход мышки на компонент и уход ее

{
 The following unit is a visual component inherited of TImage, which has the
 2 additional events OnMouseEnter and OnMouseLeave.
}

 unit ImageEx;
 interface
 uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 type
  TImageEx = class (TImage)
  private
  { Private declarations }
  FOnMouseLeave: TNotifyEvent;
  FOnMouseEnter: TNotifyEvent;
  procedure CMMouseEnter(var msg: TMessage);
  message CM_MOUSEENTER;
  procedure CMMouseLeave(var msg: TMessage);
  message CM_MOUSELEAVE;
  protected
  { Protected declarations }
  procedure DoMouseEnter; dynamic;
  procedure DoMouseLeave; dynamic;
  public
  { Public declarations }
  published
  { Published declarations }
  property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;
 procedure Register;
 implementation
 procedure Register;
 begin
  RegisterComponents('Additional', [TImageEx]);
 end;
 { TImageEx }
 procedure TImageEx.CMMouseEnter(var msg: TMessage);
 begin
  DoMouseEnter;
 end;
 procedure TImageEx.CMMouseLeave(var msg: TMessage);
 begin
  DoMouseLeave;
 end;
 procedure TImageEx.DoMouseEnter;
 begin
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
 end;
 procedure TImageEx.DoMouseLeave;
 begin
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
 end;
 end.
Взято с сайта: http://www.swissdelphicenter.ch

Получить активный элемент управления под курсором мышки

{ You may call this function in a global event procedure,

 linking as many components events to it as you need. }


 function FindControlAtPos: TWinControl;

 var

  Pt: TPoint;

 begin

  GetCursorPos(Pt);

  Result := FindControl(WindowFromPoint(Pt));

 end;



 { (Beispiel) Hier die allgemein gultige Procedure fur OnMouseUp.

 Die Behandlung von OnClick bleibt dabei erhalten:

 die Funktionalitat aus OnMouseUp kommt dazu. }


 { (example) There's the global proc for the OnMouseUp event.

 Note: OnClick keeps working, so you can "add" the OnMouseUp

 facility to no cost. }


 procedure TForm1.GenericMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

 var

  TWC: TWinControl;

 begin

  TWC := FindControlAtPos;

  //what for a class !

 Showmessage('Here we are: ' + TWC.ClassName);

  //Let it blink...

 TWC.Visible := False;

  Sleep(150);

  TWC.Visible := True;

 end;

Взято с сайта: http://www.swissdelphicenter.ch

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...