VCL控件组件大都应该重载TWinControl的虚函数WndProc来进行处理窗口消息的工作
2013-08-10 07:45
405 查看
TWinControl的构造函数中会调用MakeObjectInstance并且传递MainWndProc作为窗口消息处理函数,而MainWndProc则会调用虚函数WndProc来处理窗口消息。留个爪,对TButton的主要方法,都要仔细解读一下。
推测VCL控件组件大都应该重载TWinControl的虚函数WndProc来进行处理窗口消息的工作,举例:
// TButtonControl 研究
// TButton研究
其它继承的组件:
TCustomCheckBox = class(TButtonControl)
TCheckBox = class(TCustomCheckBox)
TRadioButton = class(TButtonControl)
推测VCL控件组件大都应该重载TWinControl的虚函数WndProc来进行处理窗口消息的工作,举例:
procedure TButtonControl.WndProc(var Message: TMessage); override; begin case Message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: if not (csDesigning in ComponentState) and not Focused then begin FClicksDisabled := True; Windows.SetFocus(Handle); // Windows单元 FClicksDisabled := False; if not Focused then Exit; end; CN_COMMAND: if FClicksDisabled then Exit; end; inherited WndProc(Message);
TButtonControl = class(TWinControl) private FClicksDisabled: Boolean; FWordWrap: Boolean; function IsCheckedStored: Boolean; procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC; procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND; procedure SetWordWrap(const Value: Boolean); protected procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; function GetActionLinkClass: TControlActionLinkClass; override; function GetChecked: Boolean; virtual; procedure SetChecked(Value: Boolean); virtual; procedure WndProc(var Message: TMessage); override; procedure CreateParams(var Params: TCreateParams); override; property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False; property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled; property WordWrap: Boolean read FWordWrap write SetWordWrap default False; public constructor Create(AOwner: TComponent); override; end; TButton = class(TButtonControl) private FDefault: Boolean; FCancel: Boolean; FActive: Boolean; FModalResult: TModalResult; procedure SetDefault(Value: Boolean); procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED; procedure CNCommand(var Message: TWMCommand); message CN_COMMAND; procedure CNCtlColorBtn(var Message: TWMCtlColorBtn); message CN_CTLCOLORBTN; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; protected procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure SetButtonStyle(ADefault: Boolean); virtual; public constructor Create(AOwner: TComponent); override; procedure Click; override; function UseRightToLeftAlignment: Boolean; override; end;
// TButtonControl 研究
constructor TButtonControl.Create(AOwner: TComponent); begin inherited Create(AOwner); if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then ImeMode := imDisable; end; procedure TButtonControl.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin inherited ActionChange(Sender, CheckDefaults); if Sender is TCustomAction then with TCustomAction(Sender) do begin if not CheckDefaults or (Self.Checked = False) then Self.Checked := Checked; end; end; function TButtonControl.GetActionLinkClass: TControlActionLinkClass; begin Result := TButtonActionLink; end; function TButtonControl.IsCheckedStored: Boolean; begin Result := (ActionLink = nil) or not TButtonActionLink(ActionLink).IsCheckedLinked; end; procedure TButtonControl.CNCtlColorStatic(var Message: TWMCtlColorStatic); begin with ThemeServices do if ThemesEnabled then begin DrawParentBackground(Handle, Message.ChildDC, nil, False); { Return an empty brush to prevent Windows from overpainting we just have created. } Message.Result := GetStockObject(NULL_BRUSH); end else inherited; end; procedure TButtonControl.WMEraseBkGnd(var Message: TWMEraseBkGnd); begin { Under theme services the background is drawn in CN_CTLCOLORSTATIC. } if ThemeServices.ThemesEnabled then Message.Result := 1 else inherited; end; procedure TButtonControl.CreateParams(var Params: TCreateParams); begin inherited; if FWordWrap then Params.Style := Params.Style or BS_MULTILINE; end; procedure TButtonControl.SetWordWrap(const Value: Boolean); begin if FWordWrap <> Value then begin FWordWrap := Value; RecreateWnd; end; end;
// TButton研究
constructor TButton.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csSetCaption, csDoubleClicks]; Width := 75; Height := 25; TabStop := True; end; procedure TButton.Click; var Form: TCustomForm; begin Form := GetParentForm(Self); if Form <> nil then Form.ModalResult := ModalResult; inherited Click; end; function TButton.UseRightToLeftAlignment: Boolean; begin Result := False; end; procedure TButton.SetButtonStyle(ADefault: Boolean); const BS_MASK = $000F; var Style: Word; begin if HandleAllocated then begin if ADefault then Style := BS_DEFPUSHBUTTON else Style := BS_PUSHBUTTON; if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then SendMessage(Handle, BM_SETSTYLE, Style, 1); end; end; procedure TButton.SetDefault(Value: Boolean); var Form: TCustomForm; begin FDefault := Value; if HandleAllocated then begin Form := GetParentForm(Self); if Form <> nil then Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl)); end; end; procedure TButton.CreateParams(var Params: TCreateParams); const ButtonStyles: array[Boolean] of DWORD = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON); begin inherited CreateParams(Params); CreateSubClass(Params, 'BUTTON'); Params.Style := Params.Style or ButtonStyles[FDefault]; end; procedure TButton.CreateWnd; begin inherited CreateWnd; FActive := FDefault; end; procedure TButton.CNCommand(var Message: TWMCommand); begin if Message.NotifyCode = BN_CLICKED then Click; end; procedure TButton.CMDialogKey(var Message: TCMDialogKey); begin with Message do if (((CharCode = VK_RETURN) and FActive) or ((CharCode = VK_ESCAPE) and FCancel)) and (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then begin Click; Result := 1; end else inherited; end; procedure TButton.CMDialogChar(var Message: TCMDialogChar); begin with Message do if IsAccel(CharCode, Caption) and CanFocus then begin Click; Result := 1; end else inherited; end; procedure TButton.CMFocusChanged(var Message: TCMFocusChanged); begin with Message do if Sender is TButton then FActive := Sender = Self else FActive := FDefault; SetButtonStyle(FActive); inherited; end; procedure TButton.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin if ThemeServices.ThemesEnabled then Message.Result := 1 else DefaultHandler(Message); end; procedure TButton.CNCtlColorBtn(var Message: TWMCtlColorBtn); begin with ThemeServices do if ThemesEnabled then begin DrawParentBackground(Handle, Message.ChildDC, nil, False); { Return an empty brush to prevent Windows from overpainting we just have created. } Message.Result := GetStockObject(NULL_BRUSH); end else inherited; end;
其它继承的组件:
TCustomCheckBox = class(TButtonControl)
TCheckBox = class(TCustomCheckBox)
TRadioButton = class(TButtonControl)
相关文章推荐
- OnClick事件的Sender参数的前世今生——TWinControl.WinProc优先捕捉到鼠标消息,然后使用IsControlMouseMsg函数进行消息转发给图形子控件(意外发现OnClick是由WM_LBUTTONUP触发的)
- 终于懂了:TWinControl主要是Delphi官方用来封装Windows的官方控件,开发者还是应该是有TCustomControl来开发三方控件
- 一句话改变TWinControl控件的left坐标的前世今生(入口函数是SetBounds,然后调用SetWindowPos起作用,并发消息更新Delphi的left属性值)
- 利用勾子监视系统或进程中的各种事件消息,截获发往目标窗口的消息并进行处理
- VCL的命令消息(一)窗口控件的命令消息
- TWinControl.DefaultHandler里的CallWindowProc(FDefWndProc)还挺有深意的,TButton对WM_PAINT消息的处理就是靠它来处理的(以前不明白为什么总是要调用inherited,其实就是没有明白TWinControl.DefaultHandler的真正用处,而且还很有用)
- 对TControl和TWinControl相同与不同之处的深刻理解(每一个WinControl就相当于扮演了整个Windows的窗口管理角色,主要是窗口显示和窗口大小)——TWinControl就两个作用(管理子控件的功能和调用句柄API的功能)
- 091110(星期二)控件消息送至父窗口处理
- delphi的消息处理机制TWinControl.WndProc
- 注意:消息都是由控件发送给父窗口处理的
- 控件消息送至父窗口处理
- 如何重载MDI程序中客户窗口的消息处理过程?
- TControl.WMLButtonUp的inherited的作用——是为了给子类控件新的处理消息的机会
- 动态创建MFCTabCtrl组件并在其父窗口中捕获,处理消息
- PostMessage对某一窗口控件进行消息发送
- TWinControl.DefaultHandler处理WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC消息的两个参数很有意思,两个都是传递句柄
- 介入API中的控件消息处理
- 使用Tab控件时子主窗口发送多个消息
- (转载)VS2010/MFC编程入门之五十四(Ribbon界面开发:使用更多控件并为控件添加消息处理函数)
- 主线程利用MsgWaitForMultipleObjects等待子线程结束时,同时处理子线程发送的窗口消息