TWinControl的消息覆盖函数大全（41个WM_函数和31个CM_函数，它的WndProc就处理鼠标(转发)键盘(取消拖动)焦点和WM_NCHITTEST一共4类消息）

Posted 2020-07-01 朝闻道

注意，这些函数只有Private一种形式（也就是不允许覆盖，但仍在动态表格中）：

其中TWinControl对TControl有10个消息进行了覆盖（红色标记），其中有2个是WM_消息，8个是CM_消息。

  TWinControl = class(TControl)
  private
    // 41个windows消息，几乎全部消息都是私有函数（因为不需要别人来调用）。很多都是覆盖消息，也有少部分是首次出现。
    // 总结规律：直接接受消息的函数都起一个中转站的作用，其函数内容都十分简单。
    // WM_PAINT第一次出现，由某些直接继承Win控件的类使用。而图形控件和自绘控件会自己响应这个消息。
    // TControl 类控件的鼠标和重绘消息是从 Parent TWinControl 中产生的。但我们只发现了鼠标消息的产生，那么重绘消息是从哪里产生出来的呢？答案是TWinControl.WMPaint
    // http://hi.baidu.com/bakyman/item/2a426ba5c6251d37020a4d42
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT; // 它调用PaintHandler函数，自己除了双缓冲以外不做处理（只有Win控件才能第一次接受这个消息）。
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; // 各种特殊效果就靠它了
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; // important7 是唯一的消息对应函数，且只有Win控件才能响应这个消息
    procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT; //
    procedure WMSysColorChange(var Message: TWMSysColorChange); message WM_SYSCOLORCHANGE;
    // 调色板
    procedure WMPaletteChanged(var Message: TMessage); message WM_PALETTECHANGED;
    procedure WMQueryNewPalette(var Message: TMessage); message WM_QUERYNEWPALETTE;
    // 重要消息
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; // fixme 值得研究，搞清楚与Application的关系
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND; // 命令消息，把WM_消息转换成CN_消息
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;    // 通知消息
    // 关键消息 http://bbs.2ccc.com/topic.asp?topicid=455945
    procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY; // important 子控件创建、销毁、被点击时，这个消息被发到父控件。可以参考 TComponent.Notification
    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; // fixme 取消内核注册，为什么？
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    // 系统消息
    procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE;
    procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE;
    // 这6个消息都转发到子控件里去，执行子类的DefaultHandler，除非子类覆盖消息索引函数。如果子类都不处理，那么执行TWinControl的DefaultHandler
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; // 给子控件发消息
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMCompareItem(var Message: TWMCompareItem); message WM_COMPAREITEM;
    procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
    procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
    procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
    // 位置
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; // 覆盖
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    // 按键
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMSysKeyDown(var Message: TWMKeyDown); message WM_SYSKEYDOWN;
    procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
    procedure WMSysKeyUp(var Message: TWMKeyUp); message WM_SYSKEYUP;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
    procedure WMCharToItem(var Message: TWMCharToItem); message WM_CHARTOITEM;
    procedure WMVKeyToItem(var Message: TWMVKeyToItem); message WM_VKEYTOITEM;
    // 焦点
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    // 输入法
    procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION;
    procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION;
    // 右键菜单，字体
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; // 覆盖，发送给Windows控件的子控件。important 很有意思很明了
    procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE;
    // 31个组件消息
    // important 心得：许多消息函数起中转站的作用。对方爱处理不处理，反正目的达到了就行了
    // 重要
    procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND; // important 毁掉后，重新创建，并加上焦点
    procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE; // important5 调用InvalidateRect后，对每一个子控件都调用此函数
    procedure CMChanged(var Message: TMessage); message CM_CHANGED; // 如果有Parent，就调用Parent.WindowProc
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; // 覆盖消息，更新状态后显示
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; // 与TControl的实现不同，调用API
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; // 简单调用API，真正显示窗口
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER; // 读取键盘布局后调用DoEnter
    procedure CMExit(var Message: TCMExit); message CM_EXIT; // 简单调用DoExit
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; // TControl也有这个函数 什么都不做
    // 一般
    procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED; // 广播消息
    procedure CMChildKey(var Message: TMessage); message CM_CHILDKEY; // 转给父组件执行
    // 广播消息
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED; // 有点特殊，先执行父类同名函数，再广播
    procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE;
    procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE;
    procedure CMTimeChange(var Message: TMessage); message CM_TIMECHANGE;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    // 通知父控件，自己被改变了
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;   // NotifyControls，会改变消息后转发消息
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;     // NotifyControls
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;   // NotifyControls
    procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; //
    //  
    procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED; // 调用API
    procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED; // 发消息，调用API
    procedure CMParentCtl3DChanged(var Message: TMessage); message CM_PARENTCTL3DCHANGED;
    procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
    procedure CMControlListChange(var Message: TMessage); message CM_CONTROLLISTCHANGE; // 简单通知父控件，并调用它的WndProc
    procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
    procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT;
    procedure CMFloat(var Message: TCMFloat); message CM_FLOAT;// 5个控件CN按键消息，还没有真懂
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CNKeyUp(var Message: TWMKeyUp); message CN_KEYUP;
    procedure CNChar(var Message: TWMChar); message CN_CHAR;
    procedure CNSysKeyDown(var Message: TWMKeyDown); message CN_SYSKEYDOWN; // important
    procedure CNSysChar(var Message: TWMChar); message CN_SYSCHAR;
end;

再看它的WndProc函数：

procedure TWinControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
begin
  with Message do
  // 只处理少部分Windows控件很明显的通用消息，简单记忆：也就6类消息（不是6个）
  // 只要是拦截的消息，都要带上Exit，不必继续传递了
  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: // important7 fixme 为什么这里也有，消息索引函数里也有呢
      begin
        inherited WndProc(Message);
        //如果窗体被挡住并且在指定的点没有控件，则返回结果为在client区。
        if (Message.Result = HTTRANSPARENT) and (ControlAtPos(ScreenToClient(
          SmallPointToPoint(TWMNCHitTest(Message).Pos)), False) <> nil) then
          Message.Result := HTCLIENT;
        Exit; // 退出
      end;
    //鼠标消息是否直接发往组件的窗体子组件
    WM_MOUSEFIRST..WM_MOUSELAST: // 13个鼠标消息，包括了WM_MOUSEMOVE WM_LBUTTONDOWN消息等等。
      begin
      // 我认为TLabel的OnClick第一原动力来自这里，但是没法调试，因为还没点击，鼠标移动也会停到这里来。必须加代码：
      if Message.Msg = WM_LBUTTONDOWN then
      begin
        tag:=10000;
      end;
      // 不是简单的判断，此函数做了无数的事情。即使返回False，也仍然执行过了此函数
      // 图形控件执行鼠标消息就靠这个函数，这个函数内部如果测试是图形控件的位置接受的鼠标消息，就会Perform执行
      if IsControlMouseMsg(TWMMouse(Message)) then // 测试是否是图形子控件的消息，而且消息已经被执行过了
      begin
        { Check HandleAllocated because IsControlMouseMsg might have freed the
          window if user code executed something like Parent := nil. }
        // 如果图形子控件处理消息有问题(没有处理)，那么放到父窗口的默认窗口函数里去执行
        // FIXME 如果Win控件本身要处理这个消息怎么办？
        if (Message.Result = 0) and HandleAllocated then
        // 我猜是因为，如果控件自身覆盖了鼠标消息，那么就不会执行到这里来了。到了这里就是让系统自动处理鼠标消息
        // 屏蔽执行似乎没问题
        // 出问题就扔给Windows默认窗口函数，为应用程序没有处理的任何窗口消息提供缺省的处理。该函数确保每一个消息得到处理。
          DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam); // API，默认窗口函数，真正起作用的一个函数，另一处不起作用
        Exit; // 退出
      end;
      end;
    WM_KEYFIRST..WM_KEYLAST: // 10个键盘消息
      if Dragging then Exit; // 退出
    WM_CANCELMODE: // 启动模式窗口, 当前窗口会收到一条 WM_CancelMode 消息; 改消息无参数。http://www.cnblogs.com/del/archive/2008/10/29/1322205.html
      if (GetCapture = Handle) // API fixme 
      and (CaptureControl <> nil) // 全局变量 fixme 要研究 
      and (CaptureControl.Parent = Self) then // 如果自己是自己的父窗口
        CaptureControl.Perform(WM_CANCELMODE, 0, 0); // 那么转发消息 fixme 问题：会转发到哪里呢？还是WndProc吗？回答：不是，图形子控件有相应的消息函数。但它就是Win控件，所以还是会执行到WndProc来。做实验  
  end;
  // 上面的消息找不到才进一步向上传递。看前面大多数消息都有Exit
  inherited WndProc(Message); // important7 最后一定向上传递消息，不管被处理过没有
end;

当然还有DefaultHandler：

procedure TWinControl.DefaultHandler(var Message);
begin
  if FHandle <> 0 then
  begin
    with TMessage(Message) do
    begin
      if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
      begin
        Result := Parent.Perform(Msg, WParam, LParam);
        if Result <> 0 then Exit;
      end;
      case Msg of
        WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
          Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
        CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
          begin
            SetTextColor(WParam, ColorToRGB(FFont.Color));
            SetBkColor(WParam, ColorToRGB(FBrush.Color));
            Result := FBrush.Handle;
          end;
      else
        if Msg = RM_GetObjectInstance then
          Result := Integer(Self)
        else
        begin
        if Msg <> WM_PAINT then
          Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
        end;
      end;
      if Msg = WM_SETTEXT then
        SendDockNotification(Msg, WParam, LParam);
    end;
  end
  else
    inherited DefaultHandler(Message);
end;

这样算下来，TWinControl总共处理了41+15-2=54个Windows消息，31+17-8=40个CM_消息，总计94个消息函数（不算WinProc和DefaultHandler），这个数字十分惊人，这些功能是Delphi适应Windows消息机制的功能保证，但做出来的程序却又不占用很多内存，实在是高明之级。

感悟：TWinControl拥有如此之多的消息函数，其子类对象却不占用很大内存，原因就是Delphi透过特殊的Dispatch函数在祖先类中对消息进行检索，而无需占用子类自身VMT表，我觉得Delphi能想出这个法子并做到这一点，实在是太牛了。对Delphi的研究越深入，就越能感觉到它的绝美。

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

特意查了一下，XE5增加了6个WM_消息的处理，分别是：

WM_INPUTLANGCHANGE
WM_MOUSEACTIVATE
WM_GESTURE
WM_GESTURENOTIFY
WM_IME_CHAR
WM_TABLET_QUERYSYSTEMGESTURESTATUS

但是没有统计CM_的新情况。