TGraphiControl响应WM_MOUSEMOVE的过程（以TPaintBox为例）

首页 > 代码库 > TGraphiControl响应WM_MOUSEMOVE的过程（以TPaintBox为例）

TGraphiControl响应WM_MOUSEMOVE的过程（以TPaintBox为例）

2024-07-03 22:21:08 227人阅读

起因：非Windows句柄控件也可以处理鼠标消息，我想知道是怎么处理的；并且想知道处理消息的顺序（比如TPaintBox和TForm都响应WM_Mouse消息该怎么办）
界面：把TPaintBox放到TForm的最左上角，不留一点缝隙，这样可以准确发送消息给TPaintBox，然后看看它处理完以后，是否同时发送给TForm继续处理，还是被截断了。
代码：分别给TForm1.PaintBox1MouseMove和TForm1.FormMouseMove事件添加代码，随便写点什么比如paintbox1.tag=10;和Form1.tag=20什么的，尽量不要使用ShowMessage，因为会触发WM_PAINT消息从而影响调试。

function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
begin
  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  begin
    if Msg.Message <> WM_QUIT then
    begin
      begin
        TranslateMessage(Msg); 
        DispatchMessage(Msg);  // 第零步，即问题所在：只能发送消息到有句柄的Windows控件。就像SendMessage和PostMessage的一定要有句柄一样
      end;
    end
  end;
end;

博主按：
1. 想要知道WM_MOUSEMOVE消息到底被哪个函数处理（第一推动力），是很难判断的。一般来说肯定在WndProc，但却不能下断点调试。因为调试的时候每次恢复显示界面都有WM_PAINT消息产生，每次都捕获了无用的消息，所以就没法继续调试了。
2. 为了解决上面这个问题，我分别在TCustomForm.WndProc,TWinControl.WndProc和TControl.WndProc的开头加上了一段代码（也可以加在WndProc的末尾，但效果没有加在开头好），有助于截获消息，但又让消息继续传递。至于如何让修改后的VCL源码生效，请到网上搜，因为不影响阅读本文的分析逻辑。

procedure TCustomForm.WndProc(var Message: TMessage);
begin
  with Message do
    case Msg of
      WM_MOUSEMOVE:   // 断点1：仅仅用作截住WM_MOUSEMOVE断点，并不真正处理WM_MOUSEMOVE消息
        self.Tag:=100; 
    end;
  // ...其它消息处理过程
  inherited WndProc(Message); // 如果没发现处理WM_MOUSEMOVE过程，消息继续向父类传递
end;
procedure TWinControl.WndProc(var Message: TMessage);
begin
  with Message do
    case Msg of
      WM_MOUSEMOVE:  // 断点2：仅仅用作截住WM_MOUSEMOVE断点，并不真正处理WM_MOUSEMOVE消息
        self.Tag:=102;
    end;
  // ...其它消息处理过程
  inherited WndProc(Message); // 如果没发现处理WM_MOUSEMOVE过程，消息继续向父类传递
end;
procedure TControl.WndProc(var Message: TMessage);
begin
  with Message do
    case Msg of
      WM_MOUSEMOVE:  // 断点3：仅仅用作截住WM_MOUSEMOVE断点，并不真正处理WM_MOUSEMOVE消息
        self.Tag:=101;
    end;      
  // ...其它消息处理过程
  Dispatch(Message); // 如果没发现处理WM_MOUSEMOVE过程，到了这里，已经无法再使用WndProc方法向父类传递消息了，所以使用Dispatch。而且必定向上传递（一般情况下TControl的父类不会不响应这些消息）
end;

然后同时在三个WM_MOUSEMOVE处下断点，发现断点首先出现在TCustomForm.WndProc的断点1，后续分析发现经过整整10个步骤才会执行程序员定义的代码。

procedure TCustomForm.WndProc(var Message: TMessage);
begin
  // 这里并没有处理WM_MOUSEMOVE消息，但是为了捕捉这个消息，额外加了
  with Message do
    case Msg of
      WM_MOUSEMOVE:
        self.Tag:=100;
    end;
  inherited WndProc(Message); // 第一步
end;

procedure TWinControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
begin
  case Message.Msg of
    WM_MOUSEFIRST..WM_MOUSELAST:
      if IsControlMouseMsg(TWMMouse(Message)) then // 第二步，捕获了，判断是哪个子控件获取了鼠标的位置消息
      begin
        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 // API
  begin
    if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
      Control := CaptureControl // 后者是全局变量
    else
      Control := nil;
  end
  else
    Control := ControlAtPos(SmallPointToPoint(Message.Pos), False); // 第三步，这里通过类函数ControlAtPos发消息CM_HITTEST测试，最后获得了鼠标所在控件。
  // 需要注意的是，这个ControlAtPos函数一旦找到这个子控件就退出，不会再次回来找。因此WM_MOUSEMOVE只会被当前Windows控件TForm1的子控件TPaintBox1只处理一次就结束了，不会再继续传递给它的父控件TForm1。
  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))); // 第四步(最重要)，找到控件以后，调用Perform方法发送(鼠标)消息给对应的实例
    Result := True;
  end;
end;

function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
  Message: TMessage;
begin
  Message.Msg := Msg;
  Message.WParam := WParam;
  Message.LParam := LParam;
  Message.Result := 0;
  // 由于TControl创建实例时已经将FWindowProc指向WndProc，所以这里实际也就是调用WndProc
  if Self <> nil then WindowProc(Message); // 第五步，调用虚函数WndProc（WindowProc是属性，TControl的构造函数里有FWindowProc := WndProc;）
  Result := Message.Result;
end;

procedure TControl.WndProc(var Message: TMessage);
begin
  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);
  end;
  Dispatch(Message); // 第七步，寻找消息索引处理函数。它在TControl.WMMouseMove里有定义。
end;

procedure TControl.WMMouseMove(var Message: TWMMouseMove);
begin
  inherited; // 第八步，会执行TControl.DefaultHandler，但一无所获
  if not (csNoStdEvents in ControlStyle) then
    with Message do
      if (Width > 32768) or (Height > 32768) then
        with CalcCursorPos do
          MouseMove(KeysToShiftState(Keys), X, Y)
      else
        MouseMove(KeysToShiftState(Keys), Message.XPos, Message.YPos); // 第九步，执行TControl.MouseMove函数
end;

procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y); // 第十步，执行程序员自定义的MouseMove函数
end;

注意TControl = class(TComponent) 里定义了属性：
property onm ouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;

// 自从执行第三步以后，这个Control早就心有所属，它代表的是PaintBox1(不是抽象的TPaintBox)，但是这个PaintBox1的属性OnMouseMove被改写了，因为在在TForm1的资源文件里发现：
object Form1: TForm1
  onm ouseMove = FormMouseMove // 没用，WM_MOUSEMOVE不会理会它
  object PaintBox1: TPaintBox
    Left = -32
    Top = -40
    Width = 217
    Height = 169
    onm ouseMove = PaintBox1MouseMove // 有这个链接，消息可以终于执行程序员自定义的函数了
  end

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  paintbox1.tag:=10; // 程序员自定义的MouseMove函数 // 如果写成 paintbox1.Color:=clRed; 那么处理完WM_MOUSEMOVE之后还会处理绘画消息
end;

虽然此时PaintBox1执行了WM_MOUSEMOVE消息对应的函数，但这还不算完，它还要回退到第二步继续往下执行：

procedure TWinControl.WndProc(var Message: TMessage);
begin
    WM_MOUSEFIRST..WM_MOUSELAST:
      if IsControlMouseMsg(TWMMouse(Message)) then
      begin
        // 从第二步执行结束后回到这里。
        if (Message.Result = 0) and HandleAllocated then
          DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam); // 第十一步，尽管已经处理完WM_MOUSEMOVE消息以后，但仍然要将这个消息扔到Windows默认函数中去处理才算结束。
        Exit; // 当前函数结束，也就是整个处理流程在这里才真正退出！！！随后回到TCustomForm.WndProc（虚函数）里，它被套在TWinControl.MainWndProc里。再往回退就回到ProcessMessage函数了，即消息的起点。
      end;
end;

疑问：
1. Window控件里套Window控件，再放一个TGraphicControl，不知道会怎么样。有空再试试。
2. 一个Window控件上有多个TGraphicControl，有相互遮盖的关系，第三步如何准确判断。
3. TGraphicControl响应其它消息的过程有空也要试试。

声明：以上内容来自用户投稿及互联网公开渠道收集整理发布，本网站不拥有所有权，未作人工编辑处理，也不承担相关法律责任，若内容有误或涉及侵权可进行投诉：投诉/举报工作人员会在5个工作日内联系你，一经查实，本站将立刻删除涉嫌侵权内容。

联系
我们

首页 > 代码库 > TGraphiControl响应WM_MOUSEMOVE的过程（以TPaintBox为例）

TGraphiControl响应WM_MOUSEMOVE的过程（以TPaintBox为例）

看完仍有疑问？有类似问题直接问程序猿