继承控件，加入鼠标移入移出两个事件，该怎么写。(23分)

从component-》new component 选择Tlabel后如何实现鼠标的移入与移出事件呢？

现有这样的：
procedure TURLLabel.WndProc(var Message: TMessage);
begin
if (Message.Msg = CM_MOUSELEAVE) then
begin
Font.Color := clWindowText;
Font.Style := Font.Style - [fsUnderline];
end;
if (Message.Msg = CM_MOUSEENTER) then
begin
Font.Color := clBlue;
Font.Style := Font.Style + [fsUnderline];
end;
inherited WndProc(Message);
end;

我想把它当作事件，应该怎么实现。

procedure cmmouse_enter(var msg:tmessage)
var anobject:tobject;
begin
anobject=tobject(msg.lparam);
if anobject<>nil
begin
做事
end;
离开同理
end;

我的意思是做成控件，而该控件包含有鼠标移入移出的事件啊。
按照下面这样子，当鼠标移入时可以改变字估的颜色，移出后字体颜色又返原了。
但在鼠标事件中不知如何体现？
unit MIOLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TMIOLabel = class(TLabel)
private
FColor:TColor;
FMouseEnter:TMouseMoveEvent;
FMouseLeave:TNotifyEvent;
FontColor:TColor;
{ Private declarations }
procedure WmMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure WmMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }
public
{ Public declarations }
published
property OnMouseEnter:TMouseMoveEvent Read FMouseEnter Write FMouseEnter;
property OnMouseLeave:TNotifyEvent Read FMouseLeave Write FMouseLeave;
Property MouseInColor:TColor read FColor Write FColor;
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TMIOLabel]);
end;

{ TMIOLabel }


procedure TMIOLabel.WmMouseEnter(var Message: TMessage);
begin
if (Message.Msg = CM_MOUSEENTER) then begin
FontColor:=Font.Color ;
Font.Color:=FColor;
Font.Style :=Font.Style +[fsUnderline];
end;
//这里应该如何跟ONmouseEnter连起。
end;

procedure TMIOLabel.WmMouseLeave(var Message: TMessage);
begin
if (Message.Msg = CM_MOUSELEAVE) then begin
Font.Color:=FontColor;
Font.Style :=Font.Style -[fsUnderline];
end;
//这里应该如何 跟OnMouseLeave事件连起
end;

end.

看一下TSpeedButton的代码不就行了

呜呜。。。。俺不懂怎么看，丢人。
bluerain：能说具体的步骤吗？谢谢

我刚好以前做过一个，给你吧。
unit Qabc;

interface

uses
Windows, Messages, SysUtils, Classes, QControls, QStdCtrls, Controls,
StdCtrls;

type
tabc = class(Tbutton)
private
FOnMouseLeave:TNotifyEvent;
FOnMouseEnter:TNotifyEvent;
procedure MouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure MouseLeave(Var msg: TMessage); message CM_MOUSELEAVE;
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('work', [tabc]);
end;

procedure tabc.MouseEnter(var Msg: TMessage);
begin
//Inherited;
if Assigned(FOnMouseEnter) then FOnMouseEnter(self);
end;

procedure tabc.MouseLeave(var Msg: TMessage);
begin
//Inherited;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(self);
end;

end.

关注

实际上是捕获两个message
CM_MOUSEENTER;
CM_MOUSELEAVE;
http://www.delphibbs.com/delphibbs/dispq.asp?lid=951712

free_knight,:有些问题啊。
我在onmouseleave中写shomwessage('a')就会一直弹出对话框，再也关不掉啊。

我也做过一个。
unit UltraLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TUltraLabel = class(TLabel)
private
FTrack:boolean;
FTrackColor:Tcolor;
FstateColor:Tcolor;
Ftrackline:boolean;
Fonmouseenter:Tnotifyevent;
Fonmouseleave:Tnotifyevent;
procedure settrackcolor(value:Tcolor);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
public
constructor Create(AOwner: TComponent); override;
published
property Track:boolean read Ftrack write Ftrack;
property Trackline:boolean read Ftrackline write Ftrackline;
property Trackcolor:Tcolor read Ftrackcolor write settrackcolor;
property OnMouseEnter:Tnotifyevent read Fonmouseenter write Fonmouseenter;
property OnMouseLeave:Tnotifyevent read Fonmouseleave write Fonmouseleave;

end;

procedure Register;

implementation

constructor TUltraLabel.Create(AOwner: TComponent);
begin
inherited create(Aowner);
Fstatecolor:=font.Color;
Ftrack:=true;
Ftrackcolor:=clred;
FtrackLine:=true;
// cursor:=CrHandPoint;
end;
procedure TUltraLabel.CMMouseEnter(var Message: TMessage);
begin
if track then
begin
font.color:=Ftrackcolor;
if Ftrackline then font.Style:=[fsunderline];
end;
if assigned(Fonmouseenter)then Fonmouseenter(self);
end;
procedure TUltraLabel.CMMouseLeave(var Message: TMessage);
begin
if track then
begin
font.color:=FStatecolor;
if Ftrackline then font.Style:=[];
end;
if assigned(Fonmouseleave)then Fonmouseleave(self);

end;

procedure TultraLabel.settrackcolor(value:Tcolor);
begin
fTrackcolor:=value;
Fstatecolor:=font.Color;
Invalidate;
end;
procedure Register;
begin
RegisterComponents('Dejun', [TUltraLabel]);
end;

end.

上面都有那个问题啊？
在OnMouseEnter里写或在OnMouseLeaver写
showmessage('aaa');

试试会怎么样。

如果想自己写控件的话，你可以参考speedbutton的源码，非常简单。
我也记不清，每次要写就去看看speedbutton的源码，一看就会。

多人接受答案了。