注意,这些函数只有Private一种形式(也就是不允许覆盖,但仍在动态表格中):
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;
时间: 2024-10-13 13:34:02