OnClick事件的Sender参数的前世今生——TWinControl.WinProc优先捕捉到鼠标消息,然后使用IsControlMouseMsg函数进行消息转发给图形子控件(意外发现OnClick是由WM_LBUTTONUP触发的)

这是一个再普通不过的Button1Click执行体:

procedure TForm1.Button1Click(Sender: TObject);
begin
    ShowMessage('I am Button1');
end;

点击Button1以后,具体过程是:Form收到Button1发来的WM_COMMAND,然后发一个CN_COMMAND给Button1,这个过程就不描述了。这里研究的是VCL在接下去是如何执行的:

procedure TButton.CNCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then Click;
end;

procedure TButton.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then Form.ModalResult := ModalResult;
  inherited Click;
end;

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); // 这里的Self代表当前TControl,也就是Button1对象
end;

说白了就是这么简单啊。

注意,每一个具有Sender参数的函数,都是由VCL框架提供的。但每一个不同的事件,分别由VCL不同函数来提供Sender参数的具体内容。以上分析仅仅分析了OnClick事件这一种情况。

-------------------------------------------------------------------------------------------------------

那么TImage1的OnClick的Sender是谁提供的呢?在Form1上只放置一个Image1,载入图片后双击增加以下代码,经过测试:

procedure TForm1.Image1Click(Sender: TObject);
begin
    ShowMessage(Sender.ClassName); // 显示结果TImage
    if Sender is TImage then
        ShowMessage(TImage(Sender).Name); // 显示结果是Image1
end;

而且鼠标点击图片后,不松手,就不会执行以上代码,这充分说明不是WM_LBUTTONDOWN触发此事件。于是忽略所有有关WM_LBUTTONDOWN的过程。

仔细查看TCustomForm的代码,并没有发现WM_LBUTTONUP的覆盖消息函数,这说明Image1的触发过程,仍是VCL框架提供的功能(要么是TControl,要么是TWinControl)。继续仔细查看,发现只有TControl对WM_LBUTTONUP有直接的响应函数:

procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;

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;

同时TWinControl.WndProc里也有对WM_LBUTTONUP的处理,那么谁先谁后呢?当然还是WndProc优先运行,因为它是Form1这个窗口所直接对应的窗口函数。只有在这里找不到处理,才会调用Dispatch去寻找消息处理函数。

procedure TWinControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
begin
  case Message.Msg of
    WM_SETFOCUS:
      begin
        Form := GetParentForm(Self);
        if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;
      end;
    WM_KILLFOCUS:
      if csFocusing in ControlState then Exit;
    WM_NCHITTEST: // 注意这里,鼠标移动时,也会不停的执行
      begin
        inherited WndProc(Message);
        if (Message.Result = HTTRANSPARENT) and (ControlAtPos(ScreenToClient(
          SmallPointToPoint(TWMNCHitTest(Message).Pos)), False) <> nil) then
          Message.Result := HTCLIENT;
        Exit;
      end;
    WM_MOUSEFIRST..WM_MOUSELAST:
    begin
      if Message.Msg = WM_LBUTTONUP then // 不这样改造,WM_MOVE消息会不停的来干扰
      begin
         tag := 50; // 下断点,可以准确捕捉鼠标点击图片后弹起时的消息
      end;
      if IsControlMouseMsg(TWMMouse(Message)) then // 检测并转发鼠标消息。如果是直接点击WinControl,那么此处捕捉无效,会继续通过TControl.WndProc和Dispatch继续传递消息
      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;
    WM_KEYFIRST..WM_KEYLAST:
      if Dragging then Exit;
    WM_CANCELMODE:
      if (GetCapture = Handle) and (CaptureControl <> nil) and
        (CaptureControl.Parent = Self) then
        CaptureControl.Perform(WM_CANCELMODE, 0, 0);
  end;
  inherited WndProc(Message);
end;

function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean;
var
  Control: TControl;
  P: TPoint;
begin
  if GetCapture = Handle then
  begin
    if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
      Control := CaptureControl
    else
      Control := nil;
  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))); // 此时调试器显示msg的值是514,经过查询WM_LBUTTONUP = $0202;正是514,说明WM_LBUTTONUP消息被Image1的父控件正确转发给Image1
    Result := True;
  end;
end;

procedure TControl.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited; // 注意,如果是直接点击Form1,会执行TCustomForm.DefaultHandler(var Message);相当于给子类控件提供了新的处理消息的机会
if csCaptureMouse in ControlStyle then MouseCapture := False; if csClicked in ControlState then begin Exclude(FControlState, csClicked); if PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then Click; // 先执行OnClick,后执行MouseUp end; DoMouseUp(Message, mbLeft); end; 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); // 执行Image1Click,注意它的Sender参数 end;

 

posted @ 2016-02-22 17:48  findumars  Views(582)  Comments(0Edit  收藏  举报