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

TGraphiControl响应WM_MOUSEMOVE的过程(以TPaintBox为例)

起因:非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响应其它消息的过程有空也要试试。