zoukankan      html  css  js  c++  java
  • TGraphiControl响应WM_MOUSEMOVE的过程(以TPaintBox为例)good

    起因:非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 OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;

    // 自从执行第三步以后,这个Control早就心有所属,它代表的是PaintBox1(不是抽象的TPaintBox),但是这个PaintBox1的属性OnMouseMove被改写了,因为在在TForm1的资源文件里发现:
    object Form1: TForm1
      OnMouseMove = FormMouseMove // 没用,WM_MOUSEMOVE不会理会它
      object PaintBox1: TPaintBox
        Left = -32
        Top = -40
        Width = 217
        Height = 169
        OnMouseMove = 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;

    总结:

    图形控件本身不能接受WM_MOUSEMOVE消息(第零步),可以把这个消息发给它的父控件(第一步),让这个父控件帮助进行处理(第二步),然后VCL帮助这个父控件找出到底是它的哪个子图形控件需要处理这个消息(第三步),找到以后用VCL自己的方法Perform把这个消息(这个方法不需要句柄)发给这个图形子控件(第四步),Perform继续转发(第五步),中间询问是否需要响应显示提示消息(第六步),最后靠TControl.Dispatch寻找到VCL已经定义好的TControl.WMMouseMove(第七步),TControl.WMMouseMove收到消息后仍有可能先去执行TControl.DefaultHandler(第八步),做一点预处理后去调用VCL定义的函数指针(第九步),如果函数指针不为空,那么真正执行程序员写的图形子控件消息响应代码(第十步)。处理完消息以后,把消息扔给Windows默认消息处理函数(第十一步),然后就一路返回了。

    其中第一步的过程比较复杂,可以参考:http://www.cnblogs.com/railgunman/archive/2010/12/10/1902524.html
    第三步也没有详细解释,但相对来说不难,就是不停的发CM_HITTEST测试

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

  • 相关阅读:
    如何在Ubuntu Unity上修改应用程序图标
    Ubuntu添加PPA源
    Ubuntu14.04下Unity桌面托盘图标显示问题
    apt-get用法
    解决ubuntu无法调整和保存屏幕亮度的问题
    终端调测命令易用性的改进
    关于Linux系统basename函数缺陷的思考
    基于VLAN的二三层转发
    【译】编写可重入和线程安全的代码
    Writing Reentrant and Thread-Safe Code(译:编写可重入和线程安全的代码)
  • 原文地址:https://www.cnblogs.com/findumars/p/3719955.html
Copyright © 2011-2022 走看看