定义和创建:

TWinControl = class(TControl)
private
FBrush: TBrush;
end; constructor TWinControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
FBrush := TBrush.Create;
FBrush.Color := FColor;
FParentCtl3D := True;
FTabOrder := -;
end;

三处使用:

procedure TWinControl.DefaultHandler(var Message);
begin
if FHandle <> then
begin
with TMessage(Message) do
begin
if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
begin
Result := Parent.Perform(Msg, WParam, LParam);
if Result <> 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; // 使用完了,还要返回Brush的句柄。这是消息的Result,不是函数的
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; procedure TWinControl.CMColorChanged(var Message: TMessage);
begin
inherited;
FBrush.Color := FColor; // 改变刷子的颜色
NotifyControls(CM_PARENTCOLORCHANGED);
end; procedure TWinControl.WMNCPaint(var Message: TMessage);
const
InnerStyles: array[TBevelCut] of Integer = (, BDR_SUNKENINNER, BDR_RAISEDINNER, );
OuterStyles: array[TBevelCut] of Integer = (, BDR_SUNKENOUTER, BDR_RAISEDOUTER, );
EdgeStyles: array[TBevelKind] of Integer = (, , BF_SOFT, BF_FLAT);
Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, );
var
DC: HDC;
RC, RW, SaveRW: TRect;
EdgeSize: Integer;
WinStyle: Longint;
begin
{ Get window DC that is clipped to the non-client area }
if (BevelKind <> bkNone) or (BorderWidth > ) then
begin
DC := GetWindowDC(Handle);
try
Windows.GetClientRect(Handle, RC);
GetWindowRect(Handle, RW);
MapWindowPoints(, Handle, RW, );
OffsetRect(RC, -RW.Left, -RW.Top);
ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
{ Draw borders in non-client area }
SaveRW := RW;
InflateRect(RC, BorderWidth, BorderWidth);
RW := RC;
if BevelKind <> bkNone then
begin
EdgeSize := ;
if BevelInner <> bvNone then Inc(EdgeSize, BevelWidth);
if BevelOuter <> bvNone then Inc(EdgeSize, BevelWidth);
with RW do
begin
WinStyle := GetWindowLong(Handle, GWL_STYLE);
if beLeft in BevelEdges then Dec(Left, EdgeSize);
if beTop in BevelEdges then Dec(Top, EdgeSize);
if beRight in BevelEdges then Inc(Right, EdgeSize);
if (WinStyle and WS_VSCROLL) <> then Inc(Right, GetSystemMetrics(SM_CYVSCROLL));
if beBottom in BevelEdges then Inc(Bottom, EdgeSize);
if (WinStyle and WS_HSCROLL) <> then Inc(Bottom, GetSystemMetrics(SM_CXHSCROLL));
end;
DrawEdge(DC, RW, InnerStyles[BevelInner] or OuterStyles[BevelOuter],
Byte(BevelEdges) or EdgeStyles[BevelKind] or Ctl3DStyles[Ctl3D] or BF_ADJUST);
end;
IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
RW := SaveRW;
{ Erase parts not drawn }
OffsetRect(RW, -RW.Left, -RW.Top);
Windows.FillRect(DC, RW, Brush.Handle); // 使用刷子绘制非客户区
finally
ReleaseDC(Handle, DC);
end;
end; inherited; if ThemeServices.ThemesEnabled and (csNeedsBorderPaint in ControlStyle) then
ThemeServices.PaintBorder(Self, False);
end;

在TForm里也有应用:

procedure TCustomForm.WMIconEraseBkgnd(var Message: TWMIconEraseBkgnd);
begin
if FormStyle = fsMDIChild then
if (FormStyle = fsMDIChild) and not (csDesigning in ComponentState) then
FillRect(Message.DC, ClientRect, Application.MainForm.Brush.Handle)
else inherited;
end; procedure TCustomForm.CMColorChanged(var Message: TMessage);
begin
inherited;
if FCanvas <> nil then FCanvas.Brush.Color := Color;
end;

颜色改变之后,重设Brush的颜色是靠TWinControl.CMColorChanged。那么Brush第一次正确设置颜色是在何处(不是指创建TWinControl时的-16777201值)呢?经过研究,回答如下:

应该是这样的:读取窗体是运行时,不是编译时

你的窗体代码设置了color,那个是个属性,会触发属性的set方法

你说的确实有道理。不过 {$R *.dfm}到底干了哪些事情啊?看来不是简单读数据,而且也会触发事件的
关键是,运行期读取到数据以后,也要进行:=赋值的,此时就会触发Set方法,Set方法里发送CM_COLORCHANGED消息

编译器只是简单加进exe,甚至dfm错了都发现不了
经常会出现vcl版本不对,编译通过,但是dfm不对,运行出错

次序就是这样: Create --> Load Properties --> SetColor --> CM_COLORCHANGED

总结:基本明白了,确实在VCL里见不到直接的颜色赋值语句。那是因为在运行期执行{$R *.dfm}的时候,读取到新的颜色值以后,同样要要给Color属性赋值(即dfm里存储的颜色)。这样就会触发SetColor函数,从而触发CM_COLORCHANGED。整个过程被{$R *.dfm}隐藏了,在VCL里无法直接看到。但是需要注意,整个过程是在运行期完成的,不是在编译期。

研究一下FBrush,它是从TWinControl才有的属性(可能是因为需要句柄)——发现{$R *.dfm}在运行期执行,而且很有深意,读到属性后赋值还会触发事件,这些无法在VCL代码里直接看到的更多相关文章

  1. 实现textbox文本页面改变触发textchanged事件,代码里修改不触发

    今天弄控件遇到一个问题,就是TextChanged,如果在代码里或在页面修改修改text值,就会触发事情,但如果在textchanged里修改text,它会不会触发呢,不会,我调试跟踪,并没发现它会重 ...

  2. js代码点击触发事件

    js触发按钮点击事件 function load(){ //下面两种方法效果是一样的 document.getElementById("target").onclick(); do ...

  3. jQuery实时监听input的值变化(input的值产生变化才会触发事件)

    //用于监听input的值变化(input的值产生变化才会触发事件) (function ($) { $.fn.watch = function (callback) { return this.ea ...

  4. 除了信号触发线程与接收者线程相同的情况能直接调用到slot,其它情况都依赖事件机制(解决上面代码收不到信号的问题其实很简单,在线程的run();函数中添加一个事件循环就可以了,即加入一句exec();),信号槽不就是一个回调函数嘛

    MainWindow::MainWindow(QWidget *parent) :   QMainWindow(parent)   {   pThreadCon = new CSerialThread ...

  5. js代码触发事件

    /*** * 需要触发谁的点击事件 * @param how_id 节点的id 如:<input id='test'/> 则how_id=test * @param how_this 这个 ...

  6. jQuery-1.9.1源码分析系列(十) 事件系统——主动触发事件和模拟冒泡处理

    发现一个小点,先前没有注意的 stopPropagation: function() { var e = this.originalEvent; ... if ( e.stopPropagation ...

  7. 去掉你代码里的 document.write("<script...

    在传统的浏览器中,同步的 script 标签是会阻塞 HTML 解析器的,无论是内联的还是外链的,比如: <script src="a.js"></script& ...

  8. jQuery 滚动条 滚动到底部(下拉到底部) 加载数据(触发事件、处理逻辑)、分页加载数据

    1.针对浏览器整个窗口滚动 主要代码: <script type="text/javascript"> ; function GetProductListPageFun ...

  9. denounce函数:Javascript中如何应对高频触发事件

    在DOM Event的世界中,以scroll.resize.mouseover等为代表的高频触发事件显得有些与众不同.通常,DOM事件只有在明确的时间点才会被触发,比如被点击,比如XMLHttpReq ...

随机推荐

  1. ZOJ 3778 Talented Chef 模拟 [ 祝愿明天省赛一帆风顺, ZJSU_Bloom WILL WIN : )

    这题的意思是给你 n 道菜,第 i 道菜需要 Ai 步才能完成 每次你能对 m 道菜分别完成一步,请问最少需要几次? 这题暴力写肯定是不行的,去年省赛的时候就是没写出来这题,今天再把思路理一理吧. 首 ...

  2. ASP.NET MVC 5 学习教程:创建连接字符串

    原文 ASP.NET MVC 5 学习教程:创建连接字符串 起飞网 ASP.NET MVC 5 学习教程目录: 添加控制器 添加视图 修改视图和布局页 控制器传递数据给视图 添加模型 创建连接字符串 ...

  3. windows下安装ruby和 rails的痛苦经历

    准备安装ruby on rails,在网上搜了下,步骤都类似,但实际安装过程中却碰到很多问题.下面详细说下: 说明下,文章是按照我尝试的过程描述的.但最终是靠 运行 railsinstaller一键式 ...

  4. 基于visual Studio2013解决算法导论之016查找最大值最小值

     题目 查找最大.最小值 解决代码及点评 #include <stdio.h> #include <stdlib.h> #include <malloc.h> ...

  5. HDU 4679 String

    String Time Limit: 2000/1000 MS (Java/Others)    Memory Limit: 65535/32768 K (Java/Others) Total Sub ...

  6. CF(435D - Special Grid)dp

    题目链接:http://codeforces.com/problemset/problem/435/D 题意:求三角形个数,三个点必须的白点上,而且三条边必须是横线,竖线或对角线,三条边上不同意出现黑 ...

  7. 杭电1874畅通project绪

    畅通project续 Time Limit: 3000/1000 MS (Java/Others)    Memory Limit: 32768/32768 K (Java/Others) Total ...

  8. JS多维数组转一维

    题目: var array = [1, [2, [3, 4], [5, 6]], 7, 8]; 写一个方法 flatArray(),得到数组 [1, 2, 3, 4, 5, 6, 7, 8] 解答: ...

  9. Linux命令: ln

    每天一个linux命令(35):ln 命令 实例1:给文件创建软链接 命令: ln -s log2013.log link2013 输出: [root@localhost test]# ll -rw- ...

  10. C语言,链表反转

    倒序思路:依次把后面的节点移往头部. struct Node{ struct Node* next; int data; }; typedef struct Node NODE; NODE* inve ...