《深入核心VCL架构剖析》笔记_第3章_面向对象程序语言和Fra
没有面向对象程序语言的支持，就像愚公移山一样，虽然不是不可能，但绝对很辛苦!
本章内容：
面向对象程序语言和VCL Framework
Framework使用面向对象程序语言的设计手法
神仙棒一挥--让它变成组件吧
这还不够，让它成为Windows控件吧
如何让Framework提供自定义的能力
不使用Window Handle的组件封装类
封装Canvas的类
COMAdmin类的设计和实现
1.面向对象程序语言和VCL Framework
VCL Framework 是由Object Pascal和汇编语言实现的，但大部分是Object Pascal实现的
面向对象三项核心技术：Inheritance, Encapsulation, Polymorphism
2.Framework使用面向对象程序语言的设计手法
抽象类法
用抽象类定义基类，然后再开发派生类改写(override)基类以提供实现服务
TAbstractClass = class(TObject)
public
procedure AbstractMethod1;virtual;abstract;
function GetSomeThing:string;virtual;abstract;
end;
TDerivedClass = class(TAbstractClass)
public
procedure AbstractMethod1;override;
function GetSomeThing:string;override;
{TDerivedClass}
procedure TDerivedClass.AbstractMethod1;
begin
//some implementation code here
end;
function TDerivedClass.GetSomeThing:string;
begin
//some implementation code here
Result:= 'Some Result String';
end;
但VCL Framework不喜欢用抽象类法，Object Pascal不允许创建抽象类对象，而且可以用接口来代替抽象类
Place Holder法
基类的一些虚方法被实现为空白的函数而不声明为抽象方法，这是VCL Framework在设计核心组件类时最常用的手法，如TCanvas类的虚拟方法CreateHandle
TCanvas = class(TPersistent)
private
...
procedure CreateHandle;virtual;
...
end;
...
procedure TCanvas.CreateHandle;
begin
end;
之后使用Place Holder设计方法的派生类再改写Place Hodler方法以提供实际的实现，如下：
TControlCanvas = class(TCanvas)
protected
...
procedure CreateHandle;override;
...
end;
procedure TControlCanvas.CreateHandle;
begin
if FDeviceContext = 0 then
begin
with CanvasList.LockList do
try
if Count >= CanvasListCacheSize then FreeDeviceContext;
FDeviceContext := FControl.GetDeviceContext(FWindowsHandle);
Add(Self);
finally
CanvasList.UnlockList;
end;
end
end;
Place Holder法的好处避免了抽象类的缺点，另外，基类如果稍后觉得需要加入任何的实现，可以直接加入，此代码可以在派生类经由Inherited关键字来执行
逐渐增加法
基类提供了基础的实现，再交由派生类提供更多的实现，如VCL Framework中TControl的构造函数，在使用了Inherited关键字调用基类构造函数之后，派生类才开始加入自定义的实现代码
constructor TControl.Create(AOwner:TComponent);
begin
Inherited Create(AOwner);
FWindowProc := WndProc;
FControlStyle := [csCaptureMouse,csClickEvents,csSetCaption,csDoubleClicks];
FFont := TFont.Create;
FFont.OnChange :=FontChanged;
FAnchors := [akLeft, akTop];
//其它代码略
...
end
三明治法
派生类在改写基类方法时，先加入一些派生类的代码，再用关键字inherited调用基类代码，最后再加入派生类的代码，如TControl的ReadState使用了此法，在TControl对象中需要先设定csReadingState状态，才能使用inherited调用基类代码
procedure TControl.ReadState(Reader:TReader);
begin
Include(FControlState, csReadingState);
if Reader.Parent is TWinControl then Parent := TWinControl(Reader.Parent);
inherited ReadState(Reader);
Exclude(FControlState, csReadingState);
if Parent <>nil then
begin
//其它代码略
...
end;
end;
使用此法的场景通常是因为派生类在使用inherited调用基类代码之前需要先改变对象的状态，再用inherited调用基类代码以便基类代码根据派生类设定状态来决定如何执行
覆写基类代码法
在面向对象的多太应用中有一种情形是特定的派生类完全不使用基类代码，完全覆写基类代码而不是改写
BootStrap法
基类定义各种服务方法，但这些服务需要使用特定的参数，如Window Handle，或Device Context Handle，但这些参数是由派生类提供的，使用这种设计的类不能且不应该创建基类对象，而只能创建派生类对象来执行。
3.神仙棒一挥--让它成为组件吧
所有VCL组件类的根类，代表基础而核心的通用组件类TComponent
3-1.VCL Framework的核心组件架构
作为VCL Framework的核心组件基础类，TComponent类必须提供以下基础服务以便派生类不再重复撰写这些相同的代码
作为基础的根组件类
可同时扮演Container组件和单一组件的功能
基础组件管理功能
基础组件互动通知功能(Notification)
同时提供可视化和非可视化组件基础
通用组件类TComponent几乎完全使用标准Object Pascal来实现，没有任何平台技术牵涉其中（后来的JavaBean也吸收了此观念）
3-2.TComponent类的设计
作为基础的根组件类以及基础组件管理功能
Name是很自然的类属性，Tag是为每一个VCL组件加入的数值特性，可在某些场合发挥非常实际的应用
TComponent = class(TPersistent)
private
FName: TComponentName;
FTag: Longint;
FFreeNotifies: TList;
public
constructor Create(AOwner:TComponent);virtual;
destructor Destroy; override;
procedure InsertComponent(AComponent: TComponent);
procedure RemoveComponent(AComponent: TComponent);
property Components[Index: Integer]: TComponent read GetComponent;
property ComponentCount: integer read GetComponentCount;
property ComponentIndex: integer read GetComponentIndex write SetComponentIndex;
property ComponentState: TComponentState read FComponentState;
property ComponentStyle: TComponentStyle read FComponentStyle;
property Owner: TComponent Read FOwner;
published
property Name:TcomponentName read FName write SetName stored False;
property Tag:Loingint read FTag write FTag default 0;
end;
其中的构造函数和析构函数具有共通的管理功能
constructor TComponent.Create(AOwner:TComponent);
begin
FComponentStyle := [csInheritable];
if AOwner <> nil then AOwner.InsertComponent(self);
end;
此实现代码即是：所有TComponent或从它派生的对象都会加入它的Owner对象管理的所有子组件串行中，而InsertComponent方法正是TComponent类提供的基础组件管理功能之一
析构函数也提供了基础组件管理功能，当TComponent对象或是派生类对象被释放时，TComponent使用了Notify设计模式一一地通知所有需要知道这个对象即将被释放的相关对象
destructor TComponent.Destroy;
var
i:integer;
begin
Destroying;
//通知所有需要知道这个对象即将被释放的相关对象
if FFreeNotifies <> nil then
begin
for i := FFreeNotifies.Count -1 downto 0 do
begin
TComponent(FFreeNotifies[i]).Notification(Self, opRemove);
if FFreeNotifies = nil then
break;
end;
FFreeNotifies.Free;
FFreeNotifies :=nil;
end
//移除本组件包含的所有子组件
DestroyComponents;
//调用Owner对象方法，从Owner对象管理的子组件中移除本对象
if FOwner <> nil then
FOwner.RemoveComponent(Self);
//调用基类释放方法
inherited Destroy;
end;
其它许多的Framework也提供了基础的对象管理服务，就象VCL的TComponent类一样
至此，TComponent仍然只使用了纯粹的Object Pascal语言来实现，没有涉及特定的平台
可同时扮演Container组件和单一组件的功能
TComponent = class(TPersistent)
private
FOwner : TComponent;//父对象引用
FComponents: TList;//所有的子组件
public
procedure InsertComponent(AComponent: TComponent);
procedure RemoveComponent(AComponent: TComponent);
property Components[Index: Integer]: TComponent read GetComponent;
property ComponentCount: integer read GetComponentCount;
property ComponentIndex: integer read GetComponentIndex write SetComponentIndex;
...
end;
基础组件互动通知功能(Notification)
TComponent使用了Notify设计模式来管理子组件，由于TComponent和它的派生对象可以任意加入到其它的组件中，也可以包含任意的子组件，因此TComponent必须提供一个通用的机制来管理和其它组件的关系，最简单有效的方法就是用通知的方式让其它对象知道发生的状态，如前面的构造函数调用了Owner类对象的InsertComponent来加入一个新的TComponent对象，其中又调用了Notification通知FComponents中每一个组件
procedure TComponent.InsertComponent(AComponent:TComponent);
begin
AComponent.ValidateContainer(Self);
ValidateRename(AComponent, '', AComponent.FName);
Insert(AComponent);
AComponent.SetReference(True);
if csDesigning in ComponentState then
AComponent.SetDesigning(True);
Notification(AComponent, opInsert);
end;
procedure TComponent.Insert(AComponent: TComponent);
begin
if FComponents = nil then FComponent := TList.Create;
FComponents.Add(AComponent);
AComponent.FOwner := Self;
end;
//注意，此函数被定义成虚函数，TComponent的派生类，可以再执行额外的代码
procedure TComponent.Notification(AComponent:TComponent;operation:TOperation);
var
i:integer;
begin
if(operation = opRemove) and(AComponent <> nil) then
RemoveFreeNotification(AComponent);
if FComponents <>nil then
for i :=0 to FComponents.Count -1 do
TComponent(FComponents[i]).Notification(AComponent, operation);
end;
另一个基础管理服务RemoveComponent方法也使用了类似的方法，用Notify设计模式来通知子组件有组件被释放了，在通知完所有相关的组件之后才会调用Remove真正把组件从FComponents中移除
procedure TComponent.RemoveComponent(AComponent:TComponent);
begin
ValidateRename(AComponent, AComponent.FName, '');
Notification(AComponent, opRemove);
AComponent.SetReference(False);
Remove(AComponent);
end;
procedure TComponent.Remove(AComponent:TComponent);
begin
AComponent.FOWner :=nil;
FComponents.Remove(AComponent);
if FComponents.Count = 0 then
begin
FComponents.Free;
FComponent :=nil;
end;
end;
同时提供可视化和非可视化组件架构基础
前述的组件管理功能使TComponent可以作为可视化和非可视化组件的基类，所以它不应该仅和可视化机制绑定在一起。可视化派生组件只须机加入可视化机制即可(如Window Handle)，而非可视化派生组件直接加入特定的功能即可
和Delphi集成开发环境交互的机制
TComponent需要提供状态让集成开发环境或执行时期了解组件是处于集成开发环境还是执行时期，也需要让外界了解组件的状态
//一些语法，集合
TComponentState = Set of(csLoading, csReading, csWriting, csDestroying, csDesigning, csAncestor, csUpdating, csFixups);
TComponentStyle = Set of(csInheritable, csCheckPropAvail);
在TComponent的实现程序中就在适当的地方指明目前组件的状态或是组件的格式
一些语法：
//枚举
TAlignment = (taLeftJustify, taRightJustify, taCenter);
TShortCut = Low(Word)..High(Word);
//方法类型
TNotifyEvent = procedure(Sender: TObject) of object;
4.这还不够，让它成为Windows控件吧
在TComponent类之下设计一个控制类(TControl)，它具备基本的控制服务，如处理鼠标服务、负责处理控制事件以及光标(Cursor)服务等，让这控制类成为其它具体控件类的基类，那么封装Windows控件的类或其它VCL Framework自定义的控件类就可以从这个控制类继承下来并且自动拥有处理鼠标、光标和事件的基本功能。如此便可以让TComponent和封装Window控件的派生类经由控制类而分离，解决了紧耦合(Tight Coupling)问题，也让VCL Framework的控件类不成为Windows平台专属的类，提供能够封装其它控件的可能性。这个控制类就成了TComponent和封装Windows控件的派生类之间的Adapter
于是就有这样的继承关系：
//分离基础组件类和特定控件类
TControl = class(TComponent)
//鼠标服务
//光标服务
//事件服务
...
end;
//封装Windows控件的类
TWinControl = class(TControl)
...
end;
TListBox = class(TWinControl)
...
end;
//其它自定义VCL控件类
TVCLControl = class(TControl)
...
end;
4-1.TControl
这是所有封装实体控件类的基类，一个控件除了可以是封装Windows本身的控件之外，也可以是VCL Framework或是开发人员撰写的自定义控件。一个控件最基本的特征就是可以响应鼠标事件、控制光标、能分派事件消息的服务。在TControl类实现这些基本的控件服务，所有从TControl派生的类将自动拥有这些功能，那么派生类只要加入封装特定实体控件的功能即可。此即TControl的设计思想。
此外，TControl作为控件类的根类，要有这些基本属性：位置、控件格式、控件父代组件、颜色、字体
TControl控件的基本信息
TControl = class(TComponent)
private
FParent: TWinControl;
FWindowProc: TWndMethod;
FLeft: integer;
FTop: integer;
FWidth: integer;
FHeight: integer;
FControlStyle: TControlStyle;
FControlState: TControlState;
...
published
property Left: integer read FLeft write SetLeft;
property Top: integer read FTop write SetTop;
property Width: integer read FWidth write SetWidth;
property Height: integer read FHeight write SetHeight;
property Cursor: TCursor read FCursor write SetCursor drfault crDefault;
property Hint: string read FHint write FHint;
end;
这其中的FParent声明成TWinControl，代表了TControl和TWinControl有紧密耦合(Tight Coupling)，TWinControl是TControl的派生类，因此FParent也可以是TControl，而不需要声明成TWinControl，但它声明成TWinControl纯粹是为了方便起见，这样的设计却造成了一些副作用。
基础资源服务
FParentFont: boolean;
FParentColor: boolean;
FAlign: TAlign;
FDragMode: TDragMode;
FIsControl: Boolean;
FText: PChar;
FFont: TFont;
FColor: TColor;
FCursor: TCursor;
当外界改变控件使用的资源时，TControl类也必须响应此类资源事件，TControl中的CM_XXXXChanged方法即是和资源改变相关的方法
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMColorChanged(var Message:TMessage); message CM_COLORCHANGED;
procedure TControl.CMFontChanged(var Message: TMessage);
begin
Invalidate;
end;
procedure TControl.CMColorChanged(var Message: TMessage);
begin
Invalidate;
end;
其中的TControl.Invalidate调用了TControl.InvalidateControl，进而其中又调用了Windows API的InvalidateRect来进行重绘工作，这样撰写是不是表示TControl类和Windows平台紧密的绑定在一起而违反了TControl类作为通用控件类的设计思想了呢？这只是默认使用Windows平台而矣，因为TControl.Invalidate被声明成虚函数，允许派生类改写重绘方法，使用自定义的方法重绘或是使用其它平台的API来重绘控件
处理鼠标的服务
TControl类中的WMXXButtonXXXX等方法就是TControl类为派生类提供的基础鼠标服务
procedure WMLButtonDown(var Message: TWMLButtonDown); message; WM_LBUTTONDOWN;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message; WM_NCLBUTTONDOWN;
procedure WMRButtonDown(var Message: TWMRButtonDown); message; WM_RBUTTONDOWN;
...
如果TControl的派生类没有额外定义处理鼠标的方法，那么TControl便会负责处理鼠标事件，这些处理鼠标的代码没有和Windows平台相关的，只有和通用消息数据结构Message相关的程序代码
VCL Framework从TControl类开始已经和Delphi的事件处理函数连接在一起了
处理消息和事件的服务
//响应外界事件的处理机制
procedure WndProc(var Message: TMessage); virtual;
procedure DefaultHandler(var Message); override;
TControl的处理消息和事件服务是所有控件类都需要执行的基本程序代码，派生类可以改写WndProc加入更详细的处理程序代码(至于TControl和派生类如何处理Windows消息和事件，参考第5、6章)
控件重绘服务
这是控件类最需要的核心服务，因为控件可以移动、改变字体/颜色/大小，当这些事件发生时控件都要进行重绘工作。TControl采用了虚拟方法实现重绘服务，以便尽量避免让TControl和特定的操作系统绑定太紧密，而让派生的特定类来改写，以便使用特定系统的API来进行重绘工作。重绘有三个方法：
procedure Repaint; virtual;
procedure Invalidate; virtual;
procedure Update; virtual;
【注】在TControl.Repaint中有两个争议的地方：其中用到了HDC，这是直接使用Windows的Device Contex对象，其次是经由Parent变量来调用PaintControls方法进行重绘工作，由于Parent是TWinControl类型的变量，基类方法中调用派生类来提供服务违反了OOP设计的原则，也让TControl必须依靠TWinControl，这是不合理的设计。比较好的设计应该是把TWinControl.PaintControls移到TControl.PaintControls，并声明为虚方法，最后把Parent类型改为TControl，这样就可以经由OOP的多态来解决紧密耦合的问题。
4-2.封装Windows控件的TWinControl类
由于TWinControl是TControl的派生类并且代表Windows控件，因此TWinControl自然加入了封装Windows控件的Handle、处理窗口事件的方法、经由Windows API 进行控件图形用户界面控制的工作以及分派窗口消息的机制
封装Windows控件
TWinControl = class(TControl)
private
FObjectInstance : Pointer;
FDefWinProc : Pointer;
FControls : TList;
FWinControls : TList;
FTabList : TList;
FBrush : TBrush;
FHandle : HWnd;
FParentWindow : HWnd;
封装Windows创建功能
创建和销毁Windows控件的功能
procedure CreateHandle;virtual;
procedure CreateParams(var Params: TCreateParams);virtual;
procedure CreateSubClass(var Params:TCreateParams; ControlClassName:Pchar);
procedure CreateWindowHandle(const Params:TCreateParams);virtual;
procedure CreateWnd;virtual;
procedure DefaultHandler(var Message);override;
procedure DestroyHandle;
procedure DestroyWindowHandle;virtual;
procedure DestroyWnd;virtual;
将在第5、6章详细讨论TWinControl及其派生类如何创建Windows控件和其它方法的意义
封装Windows消息
TWinControl必须处理默认和重要的窗口消息，以便派生类不需要重复实现这些服务，其中最重要的重绘消息WMPaint和接受Window事件的WMCommand
//下面只其中一些处理窗口消息的列表
procedure WMPaint(var Message: TWMPaint);message WM_PAINT;
procedure WMCommand(var Message: TWMCommand);message WM_COMMAND;
procedure WMNotify(var Message: TWMNotify);message WM_NOTIFY;
procedure WMSysColorChange(var Message: TWMSysColorChange);message WM_SYSCOLORCHANGE;
procedure WMHScroll(var Message: TWMHScroll);message WM_HSCROLL;
Windows控件重绘服务
Windows控件靠窗口消息WM_PAINT来绘制自己，因此TWinControl需要处理此窗口消息。其基类和派生类都需要TWinControl提供的重绘服务
procedure WMPaint(var Message: TWMPaint);message WM_PAINT;
procedure PaintHandler(var Message: TWMPaint);
procedure PaintControls(DC: HDC; First: TControl);
procedure PaintWindow(DC: HDC);virtual;
其中PaintHandler会由WMPaint调用，PaintControls负责重绘TWinControl对象中包含的子控件，因为当TWinControl封装的控件需要重绘时，它内部包含的子控件当然也需要进行重绘，如下图
由于TWinControl提供了PaintWindow虚方法，因此派生类可以改写它来提供自定义重绘的需求，如果派生类不想使用TWinControl的WMPaint函数，也可以在派生类中自行拦截WM_PAINT消息自行重绘。由于PaintHandler提供了正确计算重绘区域的程序代码，因此派生类可以直接调用TWinControl的PaintHandler来计算需要进行重绘的区域。
Double Buffer绘图技巧
这是计算机图形处理常用的技术之一：当需要显示一个画面时，先在内存中分配一块大小和画面相同的区域，先在此区域中画完要显示的内容，然后再一次切换画完的内容到画面中。如此一来画面显示的速度可以大幅增加，减少画面因为重绘而造成闪烁的情况。这种使用另外一块内存预先绘制下一画面再使用类似Memory Move的汇编语言切换的技术便称为Double Buffer。
procedure TWinControl.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
PaintBuffer: HPAINTBUFFER;
begin
if not FDoubleBuffered or (Message.DC <> 0) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
inherited
else
PaintHandler(Message);
end
else
begin
if DwmCompositionEnabled then
begin
DC := BeginPaint(Handle, PS);
try
PaintBuffer := BeginBufferedPaint(DC, PS.rcPaint, BPBF_COMPOSITED, nil, MemDC);
if PaintBuffer <> 0 then
try
Perform(WM_ERASEBKGND, MemDC, MemDC);
Perform(WM_PRINTCLIENT, MemDC, PRF_CLIENT);
if not (csPaintBlackOpaqueOnGlass in FControlStyle) then
BufferedPaintMakeOpaque(PaintBuffer, PS.rcPaint);
finally
EndBufferedPaint(PaintBuffer, True);
end;
finally
EndPaint(Handle, PS);
end;
end
else
begin
DC := BeginPaint(Handle, PS);
MemBitmap := CreateCompatibleBitmap(DC, PS.rcPaint.Right - PS.rcPaint.Left,
PS.rcPaint.Bottom - PS.rcPaint.Top);
try
MemDC := CreateCompatibleDC(DC);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
SetWindowOrgEx(MemDC, PS.rcPaint.Left, PS.rcPaint.Top, nil);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC;
if TStyleManager.IsCustomStyleActive then
WndProc(TMessage(Message))
else
WMPaint(Message);
Message.DC := 0;
BitBlt(DC, PS.rcPaint.Left, PS.rcPaint.Top,
PS.rcPaint.Right - PS.rcPaint.Left,
PS.rcPaint.Bottom - PS.rcPaint.Top,
MemDC,
PS.rcPaint.Left, PS.rcPaint.Top,
SRCCOPY);
finally
SelectObject(MemDC, OldBitmap);
end;
finally
EndPaint(Handle, PS);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
end;
end;
处理Windows消息服务
TWinControl另一个核心服务是处理消息事件的函数，将在第5、6章讨论
procedure WndProc(var Msg: TMessage); virtual;
procedure DefaultHandler(var Message); override;
4-3.不使用Windows Handle的组件封装类
VCL Framework除了封装Windows控件之外，也提供了可以让开发人员自行绘制的控件，这一支封装自定义控件类就是TGraphicControl，提供了另一种图形用户界面组件类即不封装Windows控件的组件类
TGraphicControl = class(TControl)
private
FCanvas: TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Paint; virtual;
property Canvas: TCanvas read FCanvas;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
//-------------------------------------------------------------------------------
constructor TGraphicControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;
destructor TGraphicControl.Destroy;
begin
if CaptureControl = Self then SetCaptureControl(nil);
FCanvas.Free;
inherited Destroy;
end;
procedure TGraphicControl.WMPaint(var Message: TWMPaint);
begin
if (Message.DC <> 0) and not (csDestroying in ComponentState) then
begin
Canvas.Lock;
try
Canvas.Handle := Message.DC;
try
Paint;
finally
Canvas.Handle := 0;
end;
finally
Canvas.Unlock;
end;
end;
end;
//这个虚函数将由派生类来提供实现功能
//如TBevel类的Paint改写了代码
procedure TGraphicControl.Paint;
begin
end;
由于它是从TControl继承下来的，因此具备了处理鼠标、光标的能力，但它不是封装Windows控件的类，不需要使用Windows本身的资源，只要正确处理其图形显示的结果
在TGraphicControl的实现代码中它用TControlCanvas对象来提供绘制的标地，它代表画面中某一块属于这个组件的区域，其实也就是目前Device Context中由这个组件占据的显示区域
4-4.自定义控件类TCustomControl
如果开发人员想封装Windows控件而且又想加入自定义绘制能力，可以选择从TCustomControl继承下来，它是从TWinControl类继承下来的，因此提供了封装Windows控件的能力，此外又使用了TCanvas对象，拦截WM_PAINT窗口消息以及声明Paint虚方法
TCustomControl = class(TWinControl)
private
FCanvas: TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Paint; virtual;
procedure PaintWindow(DC: HDC); override;
property Canvas: TCanvas read FCanvas;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
//------------------------------------------------------------------------------
constructor TCustomControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;
destructor TCustomControl.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;
procedure TCustomControl.WMPaint(var Message: TWMPaint);
begin
Include(FControlState, csCustomPaint);
inherited;
Exclude(FControlState, csCustomPaint);
end;
procedure TCustomControl.PaintWindow(DC: HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
TControlCanvas(FCanvas).UpdateTextFlags;
Paint;
finally
FCanvas.Handle := 0;
end;
finally
FCanvas.Unlock;
end;
end;
procedure TCustomControl.Paint;
begin
end;
其派生类只需要改写虚拟方法Paint，加入自定义绘制代码就可以在FCanvas代表的显示区域中显示自定义图形能力，注意TCustomControl改写了TWinControl的PaintWindow虚方法，它使用FCanvas对象来代表绘制的区域并且调用Paint进行重绘工作，而不象TWinControl那样调用DefaultHandler将由Windows来处理。
4-5.封装Canvas的类
TCanvas和TControlCanvas代表的是控件拥有的桌面画布区域，TCanvas是通用封装画布区域的类，而TControlCanvas则是VCL控件拥有的画布区域
TCanvas类
TCanvas作为封装画布区域的通用类，声明上又和Windows平台紧密绑定在一起，因为其中的Handle声明为HDC，其实这里可以声明得更通用一些，FHandle可以使用Adapter或Wrapper类来声明，可以减少和Windows平台的依存性，不过由于VCL Framework在设计之初就是纯粹为了Windows平台，因此这样的设计虽然降低了通用性，却不能说TCanvas设计有问题
在TCanvas类中提供了各种基础图形必要的方法，如画点、线和多边形的方法，也封装了绘制图形的各种资源，如字体(Font)、画刷(Brush)、笔(Pen)等，因此它可以提供在图形用户界面中绘制各种控件接口的服务。
在Windows中要进行绘制图形的工作，程序必须取得Device Context，在TCanvas类中负责提供Device Context的则是虚方法CreateHandle
procedure TCanvas.CreateHandle;
begin
end;
因为上述的空函数，所以必须由TCanvas的派生类改写CreateHandle，再在改写的CreateHandle中提供实体Device Contex，因此开发人员不应该直接创建TCanvas对象，而是创建TCanvas的派生类对象，例如TControlCanvas。可以声明TCanvas的对象引用，然后利用多态的功能，由这个引用来执行TCanvas派生类对象提供的Device Contex。
看看两个TCanvas的实现代码
procedure TCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
Changing;
RequiredState([csHandleValid, csPenValid]);
Winapi.Windows.SetPixel(FHandle, X, Y, ColorToRGB(Value));
Changed;
end;
procedure TCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
Winapi.Windows.RoundRect(FHandle, X1, Y1, X2, Y2, X3, Y3);
Changed;
end;
注意其中的FHandle是由TCanvas派生类创建的
其中的Changing和Changed都声明成虚拟方法，这让派生类有机会改写并决定如何通知客户端
procedure Changed;virtual;
procedure Changing;virtual;
FOnChange: TNotifyEvent;
//------------------------------------------------------------
type
TNotifyEvent = procedure(Sender: TObject) of object;
//--------------------------------------------------
procedure TCustomCanvas.Changed;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TCustomCanvas.Changing;
begin
if Assigned(FOnChanging) then FOnChanging(Self);
end;
上述代码表明TCanvas已经和事件处理函数连接在一起了
TControlCanvas类
TCanvasDC = HDC;
TControlCanvas = class(TCanvas)
private
FControl: TControl;
FDeviceContext: TCanvasDC;
FWindowHandle: HWnd;
procedure SetControl(AControl: TControl);
protected
procedure CreateHandle; override;
public
destructor Destroy; override;
procedure FreeHandle;
procedure UpdateTextFlags;
property Control: TControl read FControl write SetControl;
end;
//---------------------------------------------------------------
procedure TControlCanvas.CreateHandle;
begin
if FControl = nil then
inherited CreateHandle
else
begin
// Creation of a window could trigger messages that require
// the canvas to have a valid handle. Prevents creating two DCs.
if (FDeviceContext = 0) and (FControl is TWinControl) then
TWinControl(FControl).HandleNeeded;
if FDeviceContext = 0 then
begin
with CanvasList.LockList do
try
if Count >= CanvasListCacheSize then FreeDeviceContext;
FDeviceContext := FControl.GetDeviceContext(FWindowHandle);
Add(Self);
finally
CanvasList.UnlockList;
end;
end;
Handle := FDeviceContext;
UpdateTextFlags;
end;
end;
其中FControl.GetDeviceContext(FWindowHandle)，最终会调用Windows API GetDC来取得实体Device Context
所以TControlCanvas是经由和它绑定的TWinControl或TWinControl派生类来取得Device Context的
4-6.结合Canvas和TwinControl类
一个实例TCustomForm类，结合TWinControl封装Windows控件以及使用TCanvas类来使用Windows的Device Contex
继承关系：
TCustomForm--TScrollingWinControl--TWinControl
TCustomForm = class(TScrollingWinControl)
private
...
FCanvas : TControlCanvas;
...
end;
//-----------------------------------------------------
constructor TCustomForm.Create(AOwner: TComponent);
begin
...
CreateNew(AOwner);
...
end;
constructor TCustomForm.CreateNew(AOwner:TComponent; Dummy:integer);
begin
...
FCanvas :=TControlCanvas.Create;
FCanvas.Control := Self;
...
end;
因此TCustomForm中的FCanvas正是封装TCustomForm的桌面显示区域，并通过FCanvas类提供绘制服务来执行必要的绘制工作
5.COM Admin类的设计和实现
本部分略过...
6.结论
