深入VCL理解BCB的消息机制2

62 阅读 0 评论 41 点赞

我是靠谱客的博主清新棉花糖，最近开发中收集的这篇文章主要介绍深入VCL理解BCB的消息机制2，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

深入VCL理解BCB的消息机制2
2012-12-25 19:54未知admin
.
关键字：
　　重载TControl的WndProc方法
　　还是先谈谈VCL的继承策略。VCL中的继承链的顶部是TObject基类。一切的VCL组件和对象都继承自TObject。
　　打开BCB帮助查看TControl的继承关系：
　　TObject->TPersistent->TComponent->TControl
　　呵呵，原来TControl是从TPersistent类的子类TComponent类继承而来的。TPersistent抽象基类具有使用流stream来存取类的属性的能力。
　　TComponent类则是所有VCL组件的父类。
　　这就是所有的VCL组件包括您的自定义组件可以使用dfm文件存取属性的原因『当然要是TPersistent的子类，我想您很少需要直接从TObject类来派生您的自定义组件吧』。
　　TControl类的重要性并不亚于它的父类们。在BCB的继承关系中，TControl类的是所有VCL可视化组件的父类。实际上就是控件的意思吧。所谓可视化是指您可以在运行期间看到和操纵的控件。这类控件所具有的一些基本属性和方法都在TControl类中进行定义。
　　TControl的实现在BorlandCBuilder5SourceVclcontrol.pas中可以找到。『可能会有朋友问你怎么知道在那里？使用BCB提供的Search -> Find in files很容易找到。或者使用第三方插件的grep功能。』
　　好了，进入VCL的源码吧。说到这里免不了要抱怨一下Borland。哎，为什么要用pascal实现这一切.....:-(
　　TControl继承但并没有重写TObject的Dispatch()方法。反而提供了一个新的方法就是xycleo提到的WndProc()。一起来看看Borland的工程师们是怎么写的吧。
　　
procedure TControl.WndProc(var Message: TMessage);var　
        Form: TCustomForm;begin//由拥有control的窗体来处理设计期间的消息　
        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//如果需要，键盘消息交由拥有control的窗体来处理　
        else 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);　　
        end;　
        end// 下面一行有点特别。如果您仔细的话会看到这个消息是CM_VISIBLECHANGED.// 而不是我们熟悉的WM_开头的标准Windows消息.// 尽管Borland没有在它的帮助中提到有这一类的CM消息存在。但很显然这是BCB的// 自定义消息。呵呵，如果您对此有兴趣可以在VCL源码中查找相关的内容。一定会有不小的收获。　
        else if Message.Msg = CM_VISIBLECHANGED then　　
        with Message do　　　
        SendDockNotification(Msg, WParam, LParam);// 最后调用dispatch方法。　
        Dispatch(Message);end;
　　看完这段代码，你会发现TControl类实际上只处理了鼠标消息，没有处理的消息最后都转入Dispatch()来处理。
　　但这里需要强调指出的是TControl自己并没有获得焦点Focus的能力。TControl的子类TWinControl才具有这样的能力。我凭什么这样讲？呵呵，还是打开BCB的帮助。很多朋友抱怨BCB的帮助实在不如VC的MSDN。毋庸讳言，的确差远了。而且这个帮助还经常有问题。但有总比没有好啊。
　　言归正传，在帮助的The TWinControl Branch 分支下，您可以看到关于TWinControl类的简介。指出TWinControl类是所有窗体类控件的基类。所谓窗体类控件指的是这样一类控件：
　　1. 可以在程序运行时取得焦点的控件。
　　2. 其他的控件可以显示数据，但只有窗体类控件才能和用户发生键盘交互。
　　3. 窗体类控件能够包含其他控件(容器)。
　　4. 包含其他控件的控件又称做父控件。只有窗体类控件才能够作为其他控件的父控件。
　　5. 窗体类控件拥有句柄。
　　除了能够接受焦点之外，TWinControl的一切都跟TControl没什么分别。这一点意味着TwinControl可以对许多的标准事件作出响应，Windows也必须为它分配一个句柄。并且与这个主题相关的最重要的是，这里提到是由BCB负责来对控件进行重画以及消息处理。这就是说，TwinControl封装了这一切。
　　似乎扯的太远了。但我要提出来的问题是TControl类的WndProc方法中处理了鼠标消息。但这个消息只有它的子类TwinControl才能够得到啊!？
　　这怎么可以呢... Borland是如何实现这一切的呢？这个问题实在很奥妙。为了看个究竟，再次深入VCL吧。
　　还是在control.pas中，TWinControl继承了TControl的WndProc方法。源码如下：
　　
procedure TWinControl.WndProc(var Message: TMessage);var　
        Form: TCustomForm;　
        KeyState: TKeyboardState;　
        WheelMsg: TCMMouseWheel;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:　　　
        //下面这一句话指出，鼠标消息实际上转入IsControlMouseMsg方法来处理了。　　　
        if IsControlMouseMsg(TWMMouse(Message)) then　　　
        begin　　　　
        if Message.Result = 0 then　　　　　
        DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);　　　　
        Exit;　　　
        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);　
        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;　
        inherited WndProc(Message);end;
　　鼠标消息是由IsControlMouseMsg方法来处理的。只有再跟到IsControlMouseMsg去看看啦。源码如下：
　　
function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean;var　
        //TControl出现啦　
        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;　　
        file://TControl的Perform方法将消息交由WndProc处理。　　
        Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));　　
        Result := True;　

二TWinControl.WndProc

procedure TWinControl.WndProc(var Message: TMessage);
var
Form: TCustomForm;
LMouseEvent: TTrackMouseEvent;
P: TPoint;
Target: TControl;
begin
case Message.Msg of
     CM_UNTHEMECONTROL:
       if (csDesigning in ComponentState) and ThemeServices.ThemesAvailable then
       begin
         SetWindowTheme(Handle, ' ', ' ');
         SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_FRAMECHANGED);
       end;
     CM_SETACTIVECONTROL:
       begin
         Form := GetParentForm(Self);
         if (Form <> nil) and (Form <> Self) then
           Form.Perform(CM_SETACTIVECONTROL, Message.WParam, Message.LParam);
       end;
     WM_SETFOCUS:
       begin
         Form := GetParentForm(Self);
         if (Form <> nil) and (not (csDesigning in Form.ComponentState) or (Form.Parent = nil)) then
           if 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_MOUSELEAVE:
       begin
         FMouseInClient := False;
         if FMouseControl <> nil then
           FMouseControl.Perform(CM_MOUSELEAVE, 0, 0)
         else
           Perform(CM_MOUSELEAVE, 0, 0);
         FMouseControl := nil;
       end;
     WM_MOUSEFIRST..WM_MOUSELAST:
       begin
         if Message.Msg = WM_MOUSEMOVE then
         begin
           P := ClientToScreen(Point(TWMMouse(Message).XPos, TWMMouse(Message).YPos));
           CaptureControl := GetCaptureControl;
           if CaptureControl = nil then
             Target := FindDragTarget(P, True)
           else
             Target := CaptureControl;
           if (FMouseControl <> Target) then
           begin
             if ((FMouseControl <> nil) and (CaptureControl = nil)) or
                ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) or
                ((CaptureControl is TControl) and (CaptureControl.Parent = FMouseControl)) then
               FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
             if FMouseControl <> nil then
               FMouseControl.RemoveFreeNotification(Self);
             FMouseControl := Target;
             if FMouseControl <> nil then
               FMouseControl.FreeNotification(Self);
             if ((FMouseControl <> nil) and (CaptureControl = nil)) or
                ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
               FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
           end;
           if not FMouseInClient then
           begin
             FMouseInClient := True;
             // Register for a WM_MOUSELEAVE message which ensures CM_MOUSELEAVE
             // is called when the mouse leaves the TWinControl
             LMouseEvent.cbSize := SizeOf(LMouseEvent);
             LMouseEvent.dwFlags := TME_LEAVE;
             LMouseEvent.hwndTrack := Handle;
             LMouseEvent.dwHoverTime := HOVER_DEFAULT;
             _TrackMouseEvent(@LMouseEvent);
           end;
         end;
         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;
     WM_MOUSEACTIVATE:
       if IsControlActivateMsg(TWMMouseActivate(Message)) then
       begin
         if (Message.Result = 0) and HandleAllocated then
           inherited WndProc(Message);
         Exit;
       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);
     CM_DESTROYHANDLE:
       begin
         if Boolean(Message.WParam) then // Sender has csRecreating set
           UpdateRecreatingFlag(True);
         try
           DestroyHandle;
         finally
           if Boolean(Message.WParam) then
             UpdateRecreatingFlag(False);
         end;
         Exit;
       end;
end;
inherited WndProc(Message);

if Message.Msg = WM_UPDATEUISTATE then
     Invalidate; // Ensure control is repainted
end;

三TControl.WndProc
end;end;

procedure TControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
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
  else 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);
    end;
  end
  else if Message.Msg = CM_VISIBLECHANGED then
    with Message do
      SendDockNotification(Msg, WParam, LParam);
  Dispatch(Message);
end;