TPaintBox的前世今生
TPaintBox是一个图形控件,继承于TGraphicControl,并且只有聊聊几个函数和属性,主要就是Canvas和Paint函数,都在这里了:
1
2
3
4
5
6
7
8
9
|
TPaintBox = class (TGraphicControl) private FOnPaint: TNotifyEvent; protected procedure Paint; override; public constructor Create(AOwner: TComponent); override; property Canvas; end ; |
总结:这么简单的类也做成了一个控件,并且堂而皇之的放在System一栏里,可见的这个控件虽然简单,但应该很实用,就是其它什么功能都没有,就提供了一个关键的Canvas属性和一个Paint函数,其主要目的就是为了提供一个绘画功能,程序员可以拿它画什么都可以,在功能设计上可以说是非常简单明了(题外话,也可以以此绘画功能为基础,做成多功能控件,比如做成和TLabel一样的功能等等,因为它太简单了,几乎等同于一个TGraphicControl)。
至于它的构造函数,除了增加一个csReplicatable风格以外,几乎就什么都没做了。所以主要还是要看它的Paint;函数,代码如下:
1
2
3
4
5
6
7
8
9
10
11
12
13
|
procedure TPaintBox . Paint; begin Canvas . Font := Font; Canvas . Brush . Color := Color; if csDesigning in ComponentState then with Canvas do begin Pen . Style := psDash; Brush . Style := bsClear; Rectangle( 0 , 0 , Width, Height); end ; if Assigned(FOnPaint) then FOnPaint(Self); end ; |
可以发现它只做了三件事情:
1.准备工作,设置Canvas的字体和画刷颜色
2.在设计期画出一个虚线的框,让程序员知道它的大小
3.调用程序员事件
看样子这个TPaintBox如果不增加程序员事件,它自己是什么事情都不会做的,所以接下来做实验,在空窗体上放一个PaintBox1,增加一段代码:
1
2
3
4
5
6
7
8
9
10
|
procedure TForm1 . PaintBox1Paint(Sender: TObject); var t: TRect; begin t . Top:= 0 ; t . Left:= 0 ; t . Right:= 100 ; t . Bottom:= 100 ; PaintBox1 . Canvas . FillRect(t); // 使用画刷的颜色填充区域的颜色 end ; |
运行,没有效果。原因是它的默认color是clBtnFace,与Form1的颜色完全一致,所以运行看不出效果。
此时,通过IDE把Form1的颜色改成clAppWorkSpace,再运行还是看不出效果,屏幕一片灰暗,原因是IDE通过VCL里的代码察觉到了Form1的颜色变化,整个过程如下:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
// 第一步,Form1作为一个TControl,给它设置颜色时会调用: procedure TControl . SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; // 简单设置类成员数据(不是类属性,后者会执行相关函数) FParentColor := False ; Perform(CM_COLORCHANGED, 0 , 0 ); // Form1颜色变化的一级入口 end ; end ; // 第二步,连续执行三个CMColorChanged函数 procedure TCustomForm . CMColorChanged( var Message: TMessage); begin inherited ; if FCanvas <> nil then FCanvas . Brush . Color := Color; end ; procedure TWinControl . CMColorChanged( var Message: TMessage); begin inherited ; // 这里使自己(Form1)的显示效果失效,一旦新的绘制消息到达,就可以根据新内容重绘了 FBrush . Color := FColor; // 然后设置类成员数据画刷的颜色 NotifyControls(CM_PARENTCOLORCHANGED); // 通知所有子控件,Form1作为它们的父控件,自己的颜色已经变化了 end ; procedure TControl . CMColorChanged( var Message: TMessage); begin Invalidate; // 虚函数,所以要看是谁调用的这个函数。在这个例子中,此时当前控件是Form1,所以会调用TWinControl.Invalidate;这个过程不再展开。 end ; // 第三步,把Form1自己的显示内容失效以后,还要继续通知所有子控件: procedure TWinControl . NotifyControls(Msg: Word ); var Message: TMessage; begin Message . Msg := Msg; Message . WParam := 0 ; Message . LParam := 0 ; Message . Result := 0 ; Broadcast(Message); end ; procedure TWinControl . Broadcast( var Message); var I: Integer ; begin for I := 0 to ControlCount - 1 do begin Controls[I].WindowProc(TMessage(Message)); // 挨个通知子控件,并调用它们的相关消息函数,如果有的话 if TMessage(Message).Result <> 0 then Exit; end ; end ; // 第四步,结果PaintBox1作为子控件,还真收到了这个消息,并做出相应: procedure TControl . CMParentColorChanged( var Message: TMessage); // Same as SetColor but doesn't set ParentBackground to False procedure SetParentColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; // 把自己的颜色改成父控件的颜色 FParentColor := False ; // good 因为VCL库是非线程安全的,所以使了一个障眼法,临时不再接受新的颜色变化消息,但是一旦颜色变化完毕,马上就会改回来。 Perform(CM_COLORCHANGED, 0 , 0 ); // 发消息调用函数,使得自己的颜色变化当场生效 end ; end ; begin // 注意,在此消息处理过程中,没有改变消息的result值,因此Broadcast函数里的消息for循环得以不断执行 if FParentColor then // 默认状态下就是如此 begin if Message . wParam <> 0 then SetParentColor(TColor(Message . lParam)) else SetParentColor(FParent . FColor); // 调用子函数,把父控件的颜色设为自己的颜色,注意没有调用同名的类函数 FParentColor := True ; // 前面执行消息使颜色生效后,马上改回来 end ; end ; // 第五步,前面最后一句是PaintBox1执行Perform(CM_COLORCHANGED, 0, 0);,相当于执行: procedure TControl . CMColorChanged( var Message: TMessage); begin Invalidate; // 会调用InvalidateControl函数使自己的显示内容失效,此处不再展开 end ; // 第六步,WM_PAINT消息来了以后,会通过PaintBox1.Paint函数间接执行程序员的代码 |
总结:一旦在IDE里把Form1的颜色改变后,IDE会先把Form1的显示内容失效,然后设置Form1.FBrush.Color一个新的值,最后发消息挨个通知子控件,所有图形子控件默认都会响应(如果它的ParentColor设为True的话),因为VCL框架里在设置好了消息广播以及在TControl里就有CM_PARENTCOLORCHANGED相应的消息函数,所有图像子控件和Win控件都要继承,所以整个过程是必然的。一旦子控件响应,先设置自己的颜色,即PaintBox1.FColor := Value;,然后发消息让自己失效。这样就达到了父控件颜色变化,子控件颜色也跟着变的效果。如果是手动写代码改变父控件颜色,也是同样的执行流程。
但是通过IDE把Form1的颜色改成clAppWorkSpace后,就会调用上面整个过程,从而自动把PaintBox1的颜色也改成了与Form1一致的clAppWorkSpace,还能在IDE里当场生效,所以运行程序还是看不出效果。
那么手动把PaintBox1的颜色改成其它颜色呢?
1
2
3
4
5
|
procedure TForm1 . Button4Click(Sender: TObject); begin PaintBox1 . Canvas . Brush . Color:=clGreen; PaintBox1 . Invalidate; end ; |
注意其中的Invalidate;语句,即使上一句设置Canvas的画刷颜色起作用,想要当场生效,就得加上这句话,否则得把Form1最小化然后最大化才能使之失效一次,才能看到相应的效果,岂不麻烦。只可惜即使加上了这句话,还是不行。那就没办法了,莫名惊诧之下就只能仔细研究它的Paint源代码了,于是发现Canvas.Brush.Color := Color;,即PaintBox1使用控件属性Color覆盖了它的Canvas画刷的颜色,看来问题就出在这里呀。于是再把测试语句改成:
1
2
3
4
|
procedure TForm1 . Button4Click(Sender: TObject); begin PaintBox1 . Color:=clRed; end ; |
这回甚至都不用写Invalidate语句就能有效果了,其原因和设置Form1.Color当场有效果的原因是一致的,整个过程可以参考这里:
http://www.cnblogs.com/findumars/p/4117783.html
另外注意,PaintBox1.Color和PaintBox1.Brush.Color和PaintBox1.Canvas.Brush.Color这三个颜色本质上是三回事,其中PaintBox1.Color优先级最高,而且还会通过类属性对应的Set函数直接起作用。它们之间的关系只是有机会互相影响而已,那也得通过VCL的创造者手写的代码起作用才行,其相互关系可以参考上面那个帖子。
--------------------------------------------------------------------------
如果修改VCL代码,把TPaintBox.Paint;函数里的Canvas.Brush.Color := Color;语句去掉,那么执行
procedure TForm1.Button4Click(Sender: TObject);
begin
PaintBox1.Canvas.Brush.Color:=clRed;
end;
程序就会记住程序员在按钮里设置的颜色,然后不管是Invalidate;还是PaintBox1.Invalidate;都可使它当场生效。如果完全不写Invalidate,那么只有失效后,下次显示的时候,才会应用Button4里设置的红色,很有意思。其实源代码里写上这句话,意思无非就是说PaintBox1.Color等级最高,绘图的时候要服从它。另外就是注意,刷子的默认颜色是clWhite,注释掉那句话以后,什么都不做,马上就会在Form1上显示一个白色的PaintBox1,且永久有效。