TLabel的mouseenter消息的生与死

Question

TLabel的mouseenter消息是怎么产生的，经过什么步骤最终到达事件处理程序？？

Answer 1

mouseenter是什么呀没听说过 学习

Answer 2

可是小弟笨拙，看了也没看懂
我记得在TLabel没有句柄，如果在vc中一般不能接受消息，delphi为什么能让他接受消息呢？哪位大侠不吝赐教一下吧

Answer 3

procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;//声明消息处理句柄方法，后为消息号procedure TCustomLabel.CMMouseEnter(var Message: TMessage);
begin
  inherited;//调用祖先类中对应此消息的处理句柄
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);//如果FOnMouseEnter不是空指针，调用它指向的过程
end;FOnMouseEnter: TNotifyEvent;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
//当给OnMouseEnter赋一事件处理过程后，其值通过后面的write赋给了FOnMouseEnter,上面调用FOnMouseEnter，就等于调用了你定义的事件处理过程

Answer 4

我的意思是，鼠标在窗口上移动，当移到label上时，delphi如何知道鼠标下面有个label

Answer 5

晕 不是有label1.mousemove事件吗
Vcl绑定了mousemove事件 当鼠标移动到label上面时候windows发送一个wm_mousemove
到应用程序 应用程序收到后就转给label.mousemove处理程序

Answer 6

Delphi不知道，Window知道，如何知道，建议去问问BILL，呵呵你能做的就是接收到Window发送来的消息，然后作出处理

Answer 7

我看过一篇文章说，WINDOW不会给label发送消息，只是delphi的消息机制才会，不知道是不是这样？

Answer 8

CM打头的是VCL control message IDs，属于VCL中的自定义消息，但并不是说这样的消息由Delphi发出，它只是开发工具，开发完成后，程序执行时和它毫无关系

Answer 9

正如citytramper(^o^)所说，
TLabel或者说TGraphicControl的子类的鼠标消息，
不是Windows直接发送的，
而是Dephi的消息机制产生的

Answer 10

1,DELPHI中，只要继承自TOBJECT都可以接受消息。
2,等会儿说。。

Answer 11

先看看
procedure TApplication.HandleMessage;
var
  Msg: TMsg;
begin
  if not ProcessMessage(Msg) then Idle(Msg);
end;
delphi的消息循环
Application.Run会调用HandleMessage
当程序空闲时调用Idleprocedure TApplication.Idle(const Msg: TMsg);
var
  Control: TControl;
  Done: Boolean;
begin
  Control := DoMouseIdle;
  if FShowHint and (FMouseControl = nil) then
    CancelHint;
  Application.Hint := GetLongHint(GetHint(Control));
  Done := True;
  try
    if Assigned(FOnIdle) then FOnIdle(Self, Done);
    if Done then DoActionIdle;
  except
    HandleException(Self);
  end;
  if (GetCurrentThreadID = MainThreadID) and CheckSynchronize then
    Done := False;
  if Done then WaitMessage;
end;而产生这个CM_MOUSEENTER,CM_MOUSELEAVE就是由DoMouseIdle产生的
function TApplication.DoMouseIdle: TControl;
var
  CaptureControl: TControl;
  P: TPoint;
begin
  GetCursorPos(P);
  Result := FindDragTarget(P, True);
  if (Result <> nil) and (csDesigning in Result.ComponentState) then
    Result := nil;
  CaptureControl := GetCaptureControl;
  if FMouseControl <> Result then
  begin
    if ((FMouseControl <> nil) and (CaptureControl = nil)) or
      ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
      FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
    FMouseControl := Result;
    if ((FMouseControl <> nil) and (CaptureControl = nil)) or
      ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
      FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
  end;
end;
这就明白了吧
用FindDragTarget找到鼠标指向的控件,然后与Application的内部数据FMouseControl
这个FMouseControl保存得上一次鼠标指向的控件,然后判断发出CM_MOUSELEAVE,CM_MOUSEENTER

Answer 12

为了验证它,可以取一下这个FMouseControl.Name
由于它是Application的私有数据,正常方法取不出来,所以我查了一下它的偏移量
我这是Delphi6
窗体上放一些控件,在放个TApplicationEvent写它的OnIdle
如下unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, SUIForm, Menus, SUIMainMenu, AppEvnts, StdCtrls;type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    ApplicationEvents1: TApplicationEvents;
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.ApplicationEvents1Idle(Sender: TObject;
  var Done: Boolean);
var
  MouseControl: TControl;
begin
  MouseControl := TControl(PInteger(Integer(Application) + $48)^);
  if MouseControl <> nil then
    Label1.Caption := MouseControl.Name;
end;end.

Answer 13

1,TApplication.HandleMessage ==>TApplication.idle
  如果系统消息队列里面没有消息需要处理，就调用IDLE2，TApplication.idle==>TApplication.DoMouseIdle
  调用针对mouse的IDLE.
3, TApplication.DoMouseIdle对鼠标指向的控件发CM_MOUSELEAVE消息。4,TCONTROL接受到CM_MOUSEENTER消息后一层层往父控件转发。 procedure TControl.CMMouseEnter(var Message: TMessage);
 begin
  if FParent <> nil then
    FParent.Perform(CM_MOUSEENTER, 0, Longint(Self));
 end;
5,如果鼠标指向TCustomLabel,它接受CM_MOUSEENTER消息。。..ok...

Answer 14

上面第三项敲错了,CM_MOUSELEAVE应该是CM_MOUSEENTER

Answer 15

:to  xzgyb(老达摩) 我有个不明白的地方，Result := FindDragTarget(P, True);FindDragTarget调用FindVCLWindowFindVCLWindow的返回值是TWinControl，Tlabel是从TGraphicControl继承下来的，当鼠标从form移到label1是 FindDragTarget的返回值label1吗

Answer 16

以TLabel为例:function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
var
  Window: TWinControl;
  Control: TControl;
begin
  Result := nil;
  Window := FindVCLWindow(Pos);//这里返回的是TWinControl,但不是Label,而是它所在的容器控件
  if Window <> nil then
  begin
    Result := Window;
    Control := Window.ControlAtPos(Window.ScreenToClient(Pos), AllowDisabled);
    if Control <> nil then Result := Control;//这里才是通过ControlAtPos得到的Label
  end;
end;

Answer 17

通过 xzgyb(老达摩) 和 ehom(？！) 老师的开导，了解到mouseenter消息的来龙去脉，我又想知道其它鼠标消息是怎么到达非TWinControl控件的，下面是我的想法，不对的地方请大家指教
form上有个label，在label点左健，首先，form收到消息，进入消息处理程序procedure TWinControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
begin
  case Message.Msg of
.....
    WM_MOUSEFIRST..WM_MOUSELAST:     
      if IsControlMouseMsg(TWMMouse(Message)) then   //关键可能在这里
      begin
        { Check HandleAllocated because IsControlMouseMsg might have freed the
          window if user code executed something like Parent := nil. }
        if (Message.Result = 0) and HandleAllocated then
          DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);
        Exit;
      end;
.............
  end;
  inherited WndProc(Message);
end;
function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean;
var
  Control: TControl;
  P: TPoint;
begin
  if GetCapture = Handle then
  begin
    Control := nil;
    if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
      Control := CaptureControl;
  end else
    Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
  Result := False;
  if Control <> nil then
  begin
    P.X := Message.XPos - Control.Left;
    P.Y := Message.YPos - Control.Top;
    Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));
    Result := True;
  end;
end;
这个过程中才是发送鼠标消息的地方
如果能执行到    Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
那么label就能收到鼠标消息，但我看GetCapture = Handle 这个条件好象成立，唯一的可能是
      Control := CaptureControl;
如果CaptureControl是label的话，label也能收到消息，到这一步我就分析不下去了，CaptureControl是什么时候设置的呢？？

Answer 18

入口找错了,按照xzgyb(老达摩)说的看TApplication.DoMouseIdle中的代码

Answer 19

to ehom(？！) function TApplication.DoMouseIdle: TControl;
var
  CaptureControl: TControl;
  P: TPoint;
begin
  GetCursorPos(P);
  Result := FindDragTarget(P, True);
  if (Result <> nil) and (csDesigning in Result.ComponentState) then
    Result := nil;
  CaptureControl := GetCaptureControl;
  if FMouseControl <> Result then
  begin
    if ((FMouseControl <> nil) and (CaptureControl = nil)) or
      ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
      FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
    FMouseControl := Result;
    if ((FMouseControl <> nil) and (CaptureControl = nil)) or
      ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
      FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
  end;
end;TApplication.DoMouseIdle中发送的消息有限，好像就CM_MOUSELEAVE和CM_MOUSEENTER是不是？

Answer 20

看上面的:if ((FMouseControl <> nil) and (CaptureControl = nil)) or
  ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
  FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);//发送消息CM_MOUSELEAVE给鼠标以前所在的控件
FMouseControl := Result;//改变FMouseControl为鼠标指针现在所在的控件
if ((FMouseControl <> nil) and (CaptureControl = nil)) or
  ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
  FMouseControl.Perform(CM_MOUSEENTER, 0, 0);//发送消息CM_MOUSEENTER给鼠标指针现在所在的控件

Answer 21

CM_MOUSELEAVE和CM_MOUSEENTER消息就唯一在TApplication.DoMouseIdle里面发出来.

Answer 22

继续...上面调用了TControl.Performfunction TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
  Message: TMessage;
begin
  Message.Msg := Msg;
  Message.WParam := WParam;
  Message.LParam := LParam;
  Message.Result := 0;
  if Self <> nil then WindowProc(Message);//调用WindowProc
  Result := Message.Result;
end;property WindowProc: TWndMethod read FWindowProc write FWindowProc;constructor TControl.Create(AOwner: TComponent);
begin
...
FWindowProc := WndProc;//TControl创建实例时已经将FWindowProc指向WndProc
...
end;//所以实际上调用了WndProc
procedure TControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
  KeyState: TKeyboardState;  
  WheelMsg: TCMMouseWheel;
begin
  if (csDesigning in ComponentState) then
  begin
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.Designer <> nil) and
      Form.Designer.IsDesignMsg(Self, Message) then Exit
  end;
  if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
  begin
    Form := GetParentForm(Self);
    if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
  end
  else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
  begin
    if not (csDoubleClicks in ControlStyle) then
      case Message.Msg of
        WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:
          Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);
      end;
    case Message.Msg of
      WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);
      WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
        begin
          if FDragMode = dmAutomatic then
          begin
            BeginAutoDrag;
            Exit;
          end;
          Include(FControlState, csLButtonDown);
        end;
      WM_LBUTTONUP:
        Exclude(FControlState, csLButtonDown);
    else
      with Mouse do
        if WheelPresent and (RegWheelMessage <> 0) and
          (Message.Msg = RegWheelMessage) then
        begin
          GetKeyboardState(KeyState);
          with WheelMsg do
          begin
            Msg := Message.Msg;
            ShiftState := KeyboardStateToShiftState(KeyState);
            WheelDelta := Message.WParam;
            Pos := TSmallPoint(Message.LParam);
          end;
          MouseWheelHandler(TMessage(WheelMsg));
          Exit;
        end;
    end;
  end
  else if Message.Msg = CM_VISIBLECHANGED then
    with Message do
      SendDockNotification(Msg, WParam, LParam);
  Dispatch(Message);//调用Dispatch处理
end;

Answer 23

对，但我现在是想知道别的鼠标消息从哪来？比如mouseup,mousedown等等，大家看看我上面的分析对不对，是不是从TWincontrol.wndpro中来？？？

Answer 24

ehom(？！) 
分析的很对，但这是消息的流向，我现在想分析消息的来源

Answer 25

Dispatch方法会根据消息号码调用构件的最后代类中处理此消息的句柄方法procedure TObject.Dispatch(var Message);
asm
    PUSH    ESI
    MOV     SI,[EDX]
    OR      SI,SI
    JE      @@default
    CMP     SI,0C000H
    JAE     @@default
    PUSH    EAX
    MOV     EAX,[EAX]
    CALL    GetDynaMethod//调用GetDynaMethod
    POP     EAX
    JE      @@default
    MOV     ECX,ESI
    POP     ESI
    JMP     ECX@@default:
    POP     ESI
    MOV     ECX,[EAX]
    JMP     dword ptr [ECX].vmtDefaultHandler//如果此构件和它的祖先类中都没有对应此消息的处理句柄,调用Defaulthandler方法
end;procedure       GetDynaMethod;
{function GetDynaMethod(vmt: TClass; selector: Smallint) : Pointer;}
asm
{ -> EAX     vmt of class }
{ BX      dynamic method index }
{ <- EBX pointer to routine }
{ ZF = 0 if found }
{ trashes: EAX, ECX } PUSH EDI
XCHG EAX,EBX //交换寄存器EAX和EAX的值,即交换VMT入口地址和函数代号
JMP @@haveVMT
@@outerLoop:
MOV EBX,[EBX]  //取VMT入口地址
@@haveVMT:
MOV EDI,[EBX].vmtDynamicTable //EDI为DMT的入口
TEST EDI,EDI //测试是否存在DMT
JE @@parent //若DMT不存在，在父类中继续找
MOVZX ECX,word ptr [EDI]  //取头两个字节，即动态函数个数
PUSH ECX
ADD EDI,2
REPNE SCASW //查找
JE @@found //若找到则跳转
POP ECX
@@parent:
MOV EBX,[EBX].vmtParent //在父类中继续
TEST EBX,EBX //是否有父类
JNE @@outerLoop //有则继续查找
JMP @@exit //无则跳转
@@found:
POP EAX
ADD EAX,EAX
SUB EAX,ECX         { this will always clear the Z-flag ! }
MOV EBX,[EDI+EAX*2-4]
@@exit:
POP EDI
end;

Answer 26

然后就是接我上面的procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;//声明消息处理句柄方法，后为消息号procedure TCustomLabel.CMMouseEnter(var Message: TMessage);
begin
  inherited;//调用祖先类中对应此消息的处理句柄
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);//如果FOnMouseEnter不是空指针，调用它指向的过程
end;FOnMouseEnter: TNotifyEvent;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
//当给OnMouseEnter赋一事件处理过程后，其值通过后面的write赋给了FOnMouseEnter,上面调用FOnMouseEnter，就等于调用了你定义的事件处理过程

Answer 27

citytramper(^o^) :
以前回答过一次
是这样
可以调试一下
当移到Label上并点一下鼠标
产生消息的顺序WM_MOUSEMOVE,WM_LBUTTONDOWN,WM_LBUTTONUP
这些消息被放在主线程的消息队列里
但消息循环获取这些消息并派发到消息过程时
就象你说的那样
WM_MOUSEFIRST..WM_MOUSELAST:     
      if IsControlMouseMsg(TWMMouse(Message)) then   //关键可能在这里
      begin
        { Check HandleAllocated because IsControlMouseMsg might have freed the
          window if user code executed something like Parent := nil. }
        if (Message.Result = 0) and HandleAllocated then
          DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);
        Exit;
      end;
进入这里，调用IsControlMouseMsg
function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean;
var
  Control: TControl;
  P: TPoint;
begin
  if GetCapture = Handle then
  begin
    Control := nil;
    if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
      Control := CaptureControl;
  end else
    Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
  Result := False;
  if Control <> nil then
  begin
    P.X := Message.XPos - Control.Left;
    P.Y := Message.YPos - Control.Top;
    Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));
    Result := True;
  end;
end;
我调试时
GetCapture <> Handle
也确实是这样，因为这时鼠标没有被捕获
转入
Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
这回正确的得到Label1;
然后
这个WM_MOUSEMOVE被分发出去
在说WM_LBUTTONDOWN
然后
Label响应这个消息
procedure TControl.WMLButtonDown(var Message: TWMLButtonDown);
begin
  SendCancelMode(Self);
  inherited;
  if csCaptureMouse in ControlStyle then MouseCapture := True;
  if csClickEvents in ControlStyle then Include(FControlState, csClicked);
  DoMouseDown(Message, mbLeft, []);
end;
然后
procedure TControl.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  if csCaptureMouse in ControlStyle then MouseCapture := False;
  if csClicked in ControlState then
  begin
    Exclude(FControlState, csClicked);
    if PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then Click;
  end;
  DoMouseUp(Message, mbLeft);
end;这时Label.Click也被调用，触发OnClick事件
procedure TControl.Click;
begin
  { Call OnClick if assigned and not equal to associated action's OnExecute.
    If associated action's OnExecute assigned then call it, otherwise, call
    OnClick. }
  if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then
    FOnClick(Self)
  else if not (csDesigning in ComponentState) and (ActionLink <> nil) then
    ActionLink.Execute(Self)
  else if Assigned(FOnClick) then
    FOnClick(Self);
end;

Answer 28

： xzgyb(老达摩) 以前回答过吗？我没看到，就麻烦老大你多说说吧---------------------------------------
GetCapture <> Handle
也确实是这样，因为这时鼠标没有被捕获
-----------------------------------------
鼠标在什么时候被捕获？？如果被捕获了，并且GetCapture = Handle他进入
if GetCapture = Handle then
  begin
    Control := nil;
    if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
      Control := CaptureControl;是什么样一种情况？另外问一个弱智问题，怎么调试源代码？

Answer 29

呵呵，比较欣赏你的打破沙锅的性格Project/options/compiler
Use Debug DCUS
选上就可我想这种情况应该是在Label上按住鼠标没松开时，并在Label上移动鼠标
这种情况
为了让Label这时候也能收到WM_MOUSEMOVE
并且考虑了
如果在
窗体上按住鼠标移动，这是CaptureControl等于Self
但Control := nil
if Control <> nil then
  begin
    P.X := Message.XPos - Control.Left;
    P.Y := Message.YPos - Control.Top;
    Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));
    Result := True;
  end;
这段就不会执行，这样避免了窗体响应WM_MOUSEMOVE的代码执行两次，
不过我感觉我好像说的不对，继续讨论吧

Answer 30

xzgyb(老达摩) 有道理  if GetCapture = Handle then
进行这个判断就是为了在Label上按住鼠标没松开时，并在Label上移动鼠标并且移出label后，还是给label发送WM_MOUSEMOVE消息的，
如果没有这句判断直接用
    Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
那么上面的情况就会给FORM发送WM_MOUSEMOVE这个过程已经比较明确了，但是还有一个问题，CaptureControl在FORM上点击鼠标CaptureControl=nil
在label上点击鼠标CaptureControl 是 label 
这个CaptureControl是在什么时候设置的呢？？？？？
在这中间隔着一个消息，那就是label的WM_MOUSEMOVE
在label处理这个消息的时候会设置CaptureControl吗？

Answer 31

在WMLButtonDown里设置
procedure TControl.WMLButtonDown(var Message: TWMLButtonDown);
begin
  SendCancelMode(Self);
  inherited;
  if csCaptureMouse in ControlStyle then MouseCapture := True; 
  if csClickEvents in ControlStyle then Include(FControlState, csClicked);
  DoMouseDown(Message, mbLeft, []);
end;
这句 MouseCapture := True就是设置CaptureControl

Answer 32

设置MouseCapture就调用
procedure TControl.SetMouseCapture(Value: Boolean);
begin
  if MouseCapture <> Value then
    if Value then SetCaptureControl(Self) else SetCaptureControl(nil);
end;
procedure SetCaptureControl(Control: TControl);
begin
  ReleaseCapture;
  CaptureControl := nil;
  if Control <> nil then
  begin
    if not (Control is TWinControl) then
    begin
      if Control.Parent = nil then Exit;
      CaptureControl := Control;
      Control := Control.Parent;
    end;
    SetCapture(TWinControl(Control).Handle);
  end;
end;
好了,就这些了

Answer 33

太妙了，终于想通了： xzgyb(老达摩) 老兄帮了我的大忙，再次感谢！！！

Answer 34

哈哈,想通就好
不用谢
VCL的源代码确实奥妙无穷