zoukankan      html  css  js  c++  java
  • TControl的消息覆盖函数大全(15个WM_函数和17个CM_函数,它的WndProc就处理鼠标与键盘消息)

    注意,这些函数只有Private一种形式(也就是不允许覆盖,但仍在动态表格中)(特别注意,这里居然没有WM_PAINT函数)

      TControl = class(TComponent)
      private
        // 15个私有消息处理,大多是鼠标消息。注意,消息函数大多只是一个中介,且TWinControl并不重写。
        procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
        procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
        procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
        procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
        procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
        procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
        procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
        procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
        procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
        procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
        //
        procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
        procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
        procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
        procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; // 重新计算最大化最小化的限制和坞里的尺寸
        procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; // 真正展开右键菜单,其子类虽然覆盖这个函数,但反而只是帮助发送而已(发送给图形控件,为其增加右键菜单功能)。
        // 17个组件事件(大多是简单函数,通知某件事情,一般没有实际内容)
        // CM_显示函数
        procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; // 显示属性被改变了,那么要调用InvalidateControl重画自己。fixme 不明白这句为什么一定要这样调用,而不是执行Invalidate函数
        procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; // 3个函数都简单调用Invalidate; 但是注意,它有可能调用子类TWinControl的Invalidate函数
        procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
        procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
        procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
        procedure CMParentBiDiModeChanged(var Message: TMessage); message CM_PARENTBIDIMODECHANGED;
        // 颜色字体
        procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
        procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;  // 调用SetFont
        procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
        procedure CMParentShowHintChanged(var Message: TMessage); message CM_PARENTSHOWHINTCHANGED; // 调用 SetShowHint
        procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
        procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST; // 测试鼠标消息对子控件是否起作用
        procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; // important 有趣,给父控件发送CM_MOUSEENTER,为什么要依赖它来处理?
        procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
        procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; // important5 什么都不做,消息结果为未处理
        procedure CMFloat(var Message: TCMFloat); message CM_FLOAT;
        procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; // 给父控件发送CM_MOUSEWHEEL
    end;

    同时把它的WndProc列出来,这样它能处理的消息就齐了:

    procedure TControl.WndProc(var Message: TMessage);
    var
      Form: TCustomForm;
      KeyState: TKeyboardState;
      WheelMsg: TCMMouseWheel;
    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;
      //窗体可以为其拥有的组件来处理键盘消息
      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
      // important 图形控件的鼠标处理都在这里
      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); // 如果是鼠标移动的消息,则出现hint窗口
          WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: // 如果是左键被按下,或者双击,如果是自动拖动模式,则开始拖动,并将左键按下的状态加入组件的状态。
            begin
              if FDragMode = dmAutomatic then
              begin
                BeginAutoDrag;
                Exit;
              end;
              Include(FControlState, csLButtonDown); // important 为图形控件(也可为Win控件)增加鼠标点击状态。点击Button就会执行到这里来。
            end;
          WM_LBUTTONUP:
            Exclude(FControlState, csLButtonDown); //如果是左键放开,则将左键按下的状态剔除。
        else
          with Mouse do
            if WheelPresent and (RegWheelMessage <> 0) and //如果鼠标有滚轮,并且滚轮滑动时发出了消息
              (Message.Msg = RegWheelMessage) then
            begin
              GetKeyboardState(KeyState); // API,将256虚拟键的状态拷贝到缓存中去
              with WheelMsg do //填充记录
              begin
                Msg := Message.Msg;
                ShiftState := KeyboardStateToShiftState(KeyState);
                WheelDelta := Message.WParam;
                Pos := TSmallPoint(Message.LParam);
              end;
              MouseWheelHandler(TMessage(WheelMsg)); // 类函数,派发鼠标滚轮的消息
              Exit;
            end;
        end;
      end
      else if Message.Msg = CM_VISIBLECHANGED then
        with Message do
          SendDockNotification(Msg, WParam, LParam);
      Dispatch(Message); // 到了这里,已经无法再使用WndProc方法向父类传递消息了,所以使用Dispatch。而且必定向上传递(一般情况下TControl的父类不会不响应这些消息)
    end;

     当然还有DefaultHandler:

    procedure TControl.DefaultHandler(var Message);
    var
      P: PChar;
    begin
      with TMessage(Message) do
        case Msg of
          WM_GETTEXT:
            begin
              if FText <> nil then P := FText else P := '';
              Result := StrLen(StrLCopy(PChar(LParam), P, WParam - 1));
            end;
          WM_GETTEXTLENGTH:
            if FText = nil then Result := 0 else Result := StrLen(FText);
          WM_SETTEXT:
            begin
              P := StrNew(PChar(LParam));
              StrDispose(FText);
              FText := P;
              SendDockNotification(Msg, WParam, LParam);
            end;
        end;
    end;

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

    我还特意查了一下Delphi 5.0和Delphi 7.0的差别,主要就在于WM_MOUSEWHEEL消息的处理。

    在Delphi 5.0里只有这个处理函数:

    procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
    
    procedure TWinControl.CMMouseWheel(var Message: TCMMouseWheel);
    begin
      with Message do
      begin
        Result := 0;
        if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
          Message.Result := 1
        else if Parent <> nil then
          with TMessage(Message) do
            Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
      end;
    end;

    但是在Delphi 7.0里有两个消息处理函数:

    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
    
    procedure TControl.WMMouseWheel(var Message: TWMMouseWheel);
    begin
      if not Mouse.WheelPresent then
      begin
        Mouse.FWheelPresent := True;
        Mouse.SettingChanged(SPI_GETWHEELSCROLLLINES);
      end;
      TCMMouseWheel(Message).ShiftState := KeysToShiftState(Message.Keys);
      MouseWheelHandler(TMessage(Message));
      if Message.Result = 0 then inherited;
    end;
    
    procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
    
    procedure TControl.CMMouseWheel(var Message: TCMMouseWheel);
    begin
      with Message do
      begin
        Result := 0;
        if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
          Message.Result := 1
        else if Parent <> nil then
          with TMessage(Message) do
            Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
      end;
    end;

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

    特意查了一下XE5,它对WM_消息的处理还是15个,这也难怪,TControl能处理鼠标消息已经是法外开恩了,不能也不需要处理无限多的WM_消息。

    话说,如果我把父控件的键盘以及其它WM_消息强行转发给TControl子控件会怎么样呢?这个问题值得思考。。。

  • 相关阅读:
    PyQt作品 – PingTester – 多点Ping测试工具
    关于和技术人员交流的一二三
    Pyjamas Python Javascript Compiler, Desktop Widget Set and RIA Web Framework
    Hybrid Qt applications with PySide and Django
    pyjamas build AJAX apps in Python (like Google did for Java)
    PyQt 维基百科,自由的百科全书
    InfoQ:请问为什么仍要选择Java来处理后端的工作?
    Eric+PyQt打造完美的Python集成开发环境
    python select module select method introduce
    GUI Programming with Python: QT Edition
  • 原文地址:https://www.cnblogs.com/findumars/p/5339228.html
Copyright © 2011-2022 走看看