TWinControl的构造函数中会调用MakeObjectInstance并且传递MainWndProc作为窗口消息处理函数,而MainWndProc则会调用虚函数WndProc来处理窗口消息。留个爪,对TButton的主要方法,都要仔细解读一下。

推测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 :=
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 := ;
Height := ;
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, );
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, , 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 := ;
end else
inherited;
end; procedure TButton.CMDialogChar(var Message: TCMDialogChar);
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus then
begin
Click;
Result := ;
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 :=
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)

VCL控件组件大都应该重载TWinControl的虚函数WndProc来进行处理窗口消息的工作的更多相关文章

  1. 关于VCL的编写 (一) 如何编写自己的VCL控件

    如何编写自己的VCL控件 用过Delphi的朋友们,大概对Delphi的最喜欢Delphi的不是他的强类型的pascal语法,而是强大的VCL控件,本人就是一位VCL控件的爱好者. VCL控件的开源, ...

  2. 浅谈控件(组件)制作方法一(附带一delphi导出数据到Excel的组件实例)(原创)

    来自:http://blog.csdn.net/zhdwjie/article/details/1490741 -------------------------------------------- ...

  3. Victor 串口 VCL 控件 - 简单实用, 功能强大的 C++ Builder 串口控件!

    源:Victor 串口 VCL 控件 - 简单实用, 功能强大的 C++ Builder 串口控件! 2014年02月06日发布控件的重要更新版本: Victor 串口控件 1.5.0.2 版本 (包 ...

  4. 一句话改变TWinControl控件的left坐标的前世今生(入口函数是SetBounds,然后调用SetWindowPos起作用,并发消息更新Delphi的left属性值)

    Delphi的重要属性,主要是Enable,  Visible, Color, left等等.这里分析left,因为TWinControl里有些覆盖函数的原因,虽然起点都是TControl.SetLe ...

  5. TCustomControl绘制自己和图形子控件共四步,TWinControl关键属性方法速记

    TCustomControl = class(TWinControl) private FCanvas: TCanvas; procedure WMPaint(var Message: TWMPain ...

  6. vcl控件经常使用属性和方法

    TTabControl属性 DisplayRect:仅仅定该控件客户区的一个矩形 HotTrack:设置当鼠标经过页标签时,它的字是否有变化.假设为True,是字会变成蓝色Images:为每一个页标签 ...

  7. Android图表日历控件组件

    1.图表引擎 - AChartEngine AChartEngine是一款基于Android的图表绘制引擎,它为Android开发人员提供了非常多有用的图表绘制工具类,假设你须要在Android应用中 ...

  8. Bootstrap树控件(Tree控件组件)使用经验分享

    前言:很多时候我们在项目中需要用到树,有些树仅仅是展示层级关系,有些树是为了展示和编辑层级关系,还有些树是为了选中项然后其他地方调用选中项.不管怎么样,树控件都是很多项目里面不可或缺的组件之一.今天, ...

  9. 运行时改变控件的大小(点击后立刻ReleaseCapture,然后计算位移,最后发消息改变位置)——最有趣的是TPanel其实也有窗口标题,因此可发HTCAPTION消息

    //光标在控件不同位置时的样式 // 由于拐角这点手动精确实在困难 所以用范围 范围+3 这样很容易就找到这一点了 procedure CtrlMouseMove(Ctrl: TWinControl; ...

随机推荐

  1. SVN学习(三)——在Eclipse 中安装和使用SVN客户端插件

    0 基本概念了解 0.1 SVN的工作原理:采取客户端/服务器模式——在服务器的版本库中保存项目文件的各个版本,所有参与协同开发的程序员在自己本地电脑上保存一个工作副本.SVN支持程序员将本地副本更新 ...

  2. 用jQuery和PHP来实现转盘抽奖程序

    准备工作 首先要准备素材,抽奖的界面用到两张图片,圆盘图片和指针图片,实际应用中可以根据不同的需求制作不同的圆盘图片. 接着制作html页面,实例中我们在body中加入如下代码: <div cl ...

  3. 虚拟机实现https网络设置

    现在很多网站使用的都是https协议,想在自己的电脑上实现下, 由于自己的电脑是win10,我总是觉得在windows上布置环境不如在linux上稳定,所以在电脑上安装了虚拟机,cento系统 . 上 ...

  4. Rabbitmq消息队列(二) Hello World! 模拟简单发送接收

    1.简介 RabbitMQ是消息代理:它接受和转发消息.你可以把它当作一个邮局:当你把你要邮寄的邮件放在信箱里时,你可以肯定Postman先生最终会把邮件送到你的收件人那里.在这个比喻中,Rabbit ...

  5. Openlayer4 - 最好最强大的开源地图引擎

    Openlayer4 - 最好最强大的开源地图引擎 # githubhttps://github.com/openlayers/openlayers # 官网http://openlayers.org ...

  6. PE下挂载注册表文件然后清除系统托盘空白图标缓存

    清除了右下角通知栏图标缓存TrayNotify(否则会出现一堆空白图标)清除缓存批处理脚本.bat如何在PE系统环境下清除宿主系统的托盘图标缓存? 清除了右下角通知栏图标缓存TrayNotify(否则 ...

  7. GTS、GCK,GSR全称

    GTS:Global 3-state buffer delay 全局使能,三态 GCK:Global Clock buffer delay   全局时钟 GSR:Global set/reset bu ...

  8. OCR 即 光学字符识别

    OCR (Optical Character Recognition,光学字符识别)是指电子设备(例如扫描仪或数码相机)检查纸上打印的字符,通过检测暗.亮的模式确定其形状,然后用字符识别方法将形状翻译 ...

  9. placehoder修改

    <textarea class="layui-input description" name="description" lay-verify=" ...

  10. Google glog error LNK2001: unresolved external symbol "__declspec(dllimport) int fLI::FLAGS_XXXX 错误的解决。

    想在 windows 下使用 glog,使用类似 FLAGS_max_log_size 来设置参数,结果编译报错. 解决办法是在 项目属性 -> C/C++ -> Preprocessor ...