delphi中响应鼠标进入或离开控件的方法

Delphi没有MouseEnter与MouseLeave的事件,网上说可以响应CM_MOUSEENTER和CM_MOUSELEAVE消息来实现。这两个消息是VCL自己定义的消息,看了Delphi的Controls.pas果然看到有以下两行:

  CM_MOUSEENTER             = CM_BASE + 19;
  CM_MOUSELEAVE             = CM_BASE + 20;

其中CM_BASE = $B000

可以有两种方式来利用:

方式一:在自定义的控件中添加响应事件来实现

方式二:直接让窗体响应事件,然后判断不同的控件

以下代码从网上参考后修改并运行通过。

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TMyPanel=class(tpanel)
  public
    procedure MSGEnter(var msg:TMessage);message CM_MOUSEENTER;//响应进入的消息
    procedure MSGLeave(var msg: TMessage);message CM_MOUSELEAVE;//响应离开的消息
  end;
 
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    MYpanel:TMyPanel;
    panel:tpanel;
    procedure MSGEnter(var msg:TMessage);message CM_MOUSEENTER;//响应进入的消息
    procedure MSGLeave(var msg: TMessage);message CM_MOUSELEAVE;//响应离开的消息
    { Private declarations }
  public
    { Public declarations }
  end;
 
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
//方式一:对自定义控件定义事件
{ TMyPanel }
procedure TMyPanel.MSGEnter(var msg: TMessage);
begin
  Color:=clyellow;
end;
procedure TMyPanel.MSGLeave(var msg: TMessage);
begin
  Color:=clred;
end;
 
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
  MyPanel:=TMyPanel.Create(self);
  MyPanel.Parent:=self;
  MyPanel.Caption:='鼠标进入变黄,  鼠标离开变红';
 
  Panel:=TPanel.Create(self);
  Panel.Parent:=self;
  panel.top:=100;
end;
 
 
//方式二:用窗体事件事响应并进行判断
procedure TForm1.MSGEnter(var msg: TMessage);  
var  
  myobj : TObject;  
begin  
  myobj := TObject(msg.LParam);//用LParam进行判断鼠标进入了哪个控件   
  if (myobj <> nil) and (myobj is TPanel) then  
    TPanel(myobj).Caption := 'enter';  
end;  
  
procedure TForm1.MSGLeave(var msg: TMessage);  
var  
  myobj : TObject;  
begin  
    myobj := TObject(msg.LParam);  
  if (myobj <> nil) and (myobj is TPanel) then  
    TPanel(myobj).Caption := 'leave';  
end;
 
 
end.

如果想在设计阶段能直接添加事件以做响应,可以自定义控件并将其注册为可视化控件。

方法如下:(以下代码未经测试)

unit MyEdit;
 
interface
 
uses
   Classes, Controls, Messages, StdCtrls;
 
type
  TMyEdit = class(TEdit)
  private
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
  published
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    procedure CMMouseEnter(var Msg:TMessage);message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg:TMessage);message CM_MOUSELEAVE;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Standard', [TMyEdit]);
end;
 
{ TMyEdit }
 
procedure TMyEdit.CMMouseEnter(var Msg: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;
 
procedure TMyEdit.CMMouseLeave(var Msg: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;
 
end.

 

posted on 2019-04-27 17:10  癫狂编程  阅读(952)  评论(0编辑  收藏  举报

导航

好的代码像粥一样,都是用时间熬出来的