说到设计模式，这个是我一直有种冲动想要写点什么的，但不知如何下笔，其实今天写这篇文章也是硬着头皮写的，因为我说要写的，不能再耽搁了。
为什么拖了这么长时间，是因为不知道从设计模式，还是从具体的代码开始。为了集中精力深入研究,我还是要选择从具体代码开始。
这里我只捡几个常见的VCL类做讲。1.TControl 2.TStrings 3.TObject 4.TStream 5.TDockTree 6.TCollection 7.TImageList 8.TIcon 9.TComObject 10.TAutoObject 11.TOleControl
先考虑以下几个问题：
1.作为一个属性对象，还是继承类？
2.使用控件还是接口服务?
3.使用接口还是抽象类？
3.迭代相加还是责任独立？
原则，只有所有人都遵守原则，才会有共同语言，效率也会大幅提高。以下是本人总结:
外开内紧，基类可替子类，抽象类不可依赖，尽量使用接口隔离.
总结问题：
一。 共享数据问题。
二。 访问与隔离。
其实所有代码设计都逃不脱以上两问题。
先看TControl:
TControl = class(TComponent)
private
...
FActionLink: TControlActionLink;
FMargins: TMargins;
FPopupMenu: TPopupMenu;
FHelpType: THelpType;
...
protected
...
FAnchorOrigin: TPoint;
FOriginalParentSize: TPoint;
FExplicitLeft: Integer;
FExplicitTop: Integer;
...
public
...
property Anchors: TAnchors read FAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored;
...
published
property AlignWithMargins: Boolean read GetAlignWithMargins write SetAlignWithMargins default False;
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 default crDefault;
property Hint: string read FHint write FHint stored IsHintStored;
property HelpType: THelpType read FHelpType write FHelpType default htContext;
property HelpKeyword: String read FHelpKeyword write SetHelpKeyword stored IsHelpContextStored;
property HelpContext: THelpContext read FHelpContext write SetHelpContext stored IsHelpContextStored default 0;
property Margins: TMargins read FMargins write SetMargins;
end;
TControl功能如下：
1.消息机制的开始，Windows的消息机制并不是从TComponent开始，也不是TWinControl，而是TControl,这点非常有意思且值得研究.而消息机制依靠DELPHI的DispatchMessage。
2.提供控件类型和控件状态信息，FControlStyle决定怎么做，而FControlState决定做什么。
3.提供FConstraints、FMargins及FAnchors来对大小及位置的控制。另外还提供FExplicitLeft，FExplicitTop等又提供了严格Left,Top等来控制位置。
4.提供了浮动停靠相关属性：FDragKind，FDockOrientation，FHostDockSite，FUndockWidth，FUndockHeight，FLRDockWidth，FTBDockHeight，FFloatingDockSiteClass等。
5.帮助相关的三个属性：FHelpType,FHelpKeyword,FHelpContext.
6.FHint: string提示窗口内容,FActionLink桥椄一个Action。
7.当然除了以上5种属性外，还有一些自定义消息及鼠标消息及WM_CANCELMODE和WM_WINDOWPOSCHANGED消息
所用的设计模式：
一.控件本身不能独立存在，必须是子控件（不是子窗体）,而且它必须依赖窗口而存在.故:
FParent: TWinControl;
FWindowProc: TWndMethod;
这里有一个问题，FParent这个是什么时候设置的?如果运行期创建那好知道，但DELPHI的IDE并没源代码，所以我现在只能猜测：在设计期1.Control := TControl.Create(FoucsWinContrl) 2.Control.Parent := FoucsWinControl; 这个FoucsWinControl一定是TCustomForm或TCustomDataMoudle或TCustomePanel等.
protected
property WindowProc: TWndMethod read FWindowProc write FWindowProc;
property Parent: TWinControl read FParent write SetParent; //李维觉得这里有违设计模式原则，其实我倒觉得不然。李维所理解的父窗体只是同类的或者更高层类的，其实属于那个类那是自然规律。TControl的父类本来就是TWinControl，因为只有窗口才能显示，其他的控件不行。这也说明，书上的专家说的，不一定是正确的，特别是像李维这种主观性较强的作家。
procedure WndProc(var Message: TMessage); virtual;
begin
....
Dispatch(Message);
end;
procedure TObject.Dispatch(var Message);
asm
PUSH ESI //申请局部变量
MOV SI,[EDX] //取Message.Msg的低16
OR SI,SI 测试SI是否为0
JE @@default //为零则跳直接调用DefaultHandler
CMP SI,0C000H //
JAE @@default //如果Message.Msg >＝ 0C000H,即大于或等于30k(49152)直接调用DefaultHandler
PUSH EAX //暂存Self的指针
MOV EAX,[EAX] //将Self传入以var Message的处理方法，比如procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
CALL GetDynaMethod //取得调用动态方法(Dynmic声明的)地址并保存到ESI中.
POP EAX //返回现场
JE @@default 如果EAX被破坏，调用DefaultHandler
MOV ECX,ESI 将目标地址给ECX
POP ESI 恢复ESI
JMP ECX 执行动态方法(Dynmic声明的)
@@default:
POP ESI //清除堆栈
MOV ECX,[EAX] //设计Self指针
JMP DWORD PTR [ECX] + VMTOFFSET TObject.DefaultHandler //至于DefaultHandler源代码不说，不是重点,我只知道他会调用当前类的procedure DefaultHandler(var Message); override;
end;
这种模式怎么说呢？应该说是“访问与隔离”形式的。如果要找个模式与这对应，我选择“迭代模式”，从TControl的WndProc迭代到功能更强大的TWinControl的WndProc，从TObject的DefaultHandler迭代到TControl,TWinControl功能更强大的DefaultHandler。其实这也是最常见的，因为只要有继承就可以说迭代。
另外，DefaultHandler的实现使用了拦截WIN消息处理，并使用了自己的内存变量TEXT，这可以说成是“代理模式”？
二,TControl使用了大量的状态以类型值，将大量控件的形为整合到一起,并根据具体的内容而进行具体行为。
TControlState = set of (csLButtonDown, csClicked, csPalette,
csReadingState, csAlignmentNeeded, csFocusing, csCreating,
csPaintCopy, csCustomPaint, csDestroyingHandle, csDocking,
csDesignerHide, csPanning, csRecreating, csAligning);
TControlStyle = set of (csAcceptsControls, csCaptureMouse,
csDesignInteractive, csClickEvents, csFramed, csSetCaption, csOpaque,
csDoubleClicks, csFixedWidth, csFixedHeight, csNoDesignVisible,
csReplicatable, csNoStdEvents, csDisplayDragImage, csReflector,
csActionClient, csMenuEvents, csNeedsBorderPaint, csParentBackground,
csPannable, csAlignWithMargins);
比如:if csCaptureMouse in ControlStyle then MouseCapture := True; 设置控件的鼠标激活功能。
这种模式也许可以叫"状态模式"，行为由状态来决定。
三,TSizeConstraints和TMargins作为一个控件大小和位置的装饰者身份存在的，应该属于“装饰者模式”。
FAnchors := [akLeft, akTop];
FConstraints := TSizeConstraints.Create(Self);
FConstraints.OnChange := DoConstraintsChange;
FMargins := TMargins.Create(Self);
FMargins.OnChange := DoMarginChange;
因为控件不是窗口也就不存在大小，所以必须依托他的父窗口而存在。
procedure TWinControl.AlignControl(AControl: TControl);
var
Rect: TRect;
begin
if not HandleAllocated or (csDestroying in ComponentState) then Exit; 如果正在释放或句柄还没分配，离开
if FAlignLevel <> 0 then 正在调整控件的位置和大小，再次请求。基本上可能不存在，只有在执行EnableAlign语句时候才有意义.
Include(FControlState, csAlignmentNeeded)
else
begin
DisableAlign;
try
Rect := GetClientRect;
AlignControls(AControl, Rect); //这个方法在DELPHI也是经过几次修改,蛮复杂的。
finally
Exclude(FControlState, csAlignmentNeeded);
EnableAlign;
end;
end;
end;
AlignControls在处理逻辑包括：1.只有使用了非alnone或者非[akLeft,akTop]的才会需求调整。2.控件可能是容器各整那些控件。3.对于alnone和anchors各种组合如何处理。
作为装饰者，需要一个连接对象（拥有者对象），并且都带有一个change方法和一个OnChange属性。在DELPHI中这种模式相当广泛。装饰者的作用也相当受限于特定的类。
四，DragKind: TDragKind等这类属性又是一结构模式，所有控件都具有这DELPHI独特的拖动和依靠属性。这种模式一般涉及到两种控件，我认为可以称之“桥接模式”。
而FHelpType,FHelpKeyword,FHelpContext这三个属性只是为了响应WM_HELP而设计的，也就是说不从TControl就开始支持Help消息了。
五，TAction类是DELPHI设计模式很典型的一个事例，通过TACTIONLINE链接到客户端，并与之关联相应的事件。这种模式其实涉及到两种模式“桥接模式”和“命令模式”。
再看TStrings:
TStrings = class(TPersistent)
private
...
FDefined: TStringsDefined;
FUpdateCount: Integer;
function GetLineBreak: string;
procedure SetLineBreak(const Value: string);
...
protected
...
procedure DefineProperties(Filer: TFiler); override;
procedure Error(const Msg: string; Data: Integer); overload;
procedure Error(Msg: PResStringRec; Data: Integer); overload;
function Get(Index: Integer): string; virtual; abstract;
function GetObject(Index: Integer): TObject; virtual;
...
public
...
function Equals(Strings: TStrings): Boolean;
function GetEnumerator: TStringsEnumerator;
procedure Clear; virtual; abstract;
procedure Delete(Index: Integer); virtual; abstract;
procedure Insert(Index: Integer; const S: string); virtual; abstract;
procedure InsertObject(Index: Integer; const S: string; AObject: TObject); virtual;
property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator;
property Text: string read GetTextStr write SetTextStr;
property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
...
end;
对于TStrings类，我觉得是最有趣及艺术的类之一。本身是一个抽象类，不能创建实例。只有五个抽象方法，却演变出很多的类，最常用的莫过于TStringList.
function Get(Index: Integer): string; virtual; abstract;
function GetCount: Integer; virtual; abstract;
procedure Clear; virtual; abstract;
procedure Delete(Index: Integer); virtual; abstract;
procedure Insert(Index: Integer; const S: string); virtual; abstract;
其中，Get、GetCount为保护类型，其余三个为public类型。这个类告诉我们，怎样去设计一个容器类。一个容器类需要的是无法几个常用地动作：增，删，改，取，存，项数。这个五个动作
变化很多，不是固定的，所以应该抽象出来，由实际的类来实现。其实，这里还是应该有一定难度的，设计这样容器，如果我们不知道他有多少种变数，那么这个容器同样是不好设计的。对于TStrings类
最基本的有TStringList,最变化的有(D7版)：
TStringList = class(TStrings) 这个就不用说，基本类
TTabStrings = class(TStrings) 与windows的SysTabControl32类结合起来，得到新的TStrings.这个时候，往往是windows提供的缓存。比如Get函数：SendMessage(FTabControl.Handle, TCM_GETITEM, Index, Longint(@TCItem))
TTreeStrings = class(TStrings) 这是delphi自己设计的一字符串，与控件TCustomTreeView(windows下是SysTreeView32)相结合，提供一种持久化性质，可以将数据保存到磁盘上。（注意，本身与windows无关，这与上面的TTabStrings 不相同）
TRichEditStrings = class(TStrings) 与TTabStrings相同，与windows的richedit类相结合，由windows提供的缓存。取得某行的内容：SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
TPageAccess = class(TStrings) 与TabControl相似的控件，但完全是由Delphi的TCustomControl而来的，也就说完成是由DELPHI捏造出来的（但是很好用,TPage相结合）。
THeaderStrings = class(TStrings) 这也是个Delphi杜撰出来的类，不过这个类不太好用，似乎少了点事件，当然我们也可以手动访问。（Delphi其实做得也蛮多，体现了一个开发软件供应商的大局,不但要精还要全）
TStringGridStrings = class(TStrings) 这个不用说了，StringGrid的Rows,Cols使用它
TStringSparseList = class(TStrings) 这个类很巧妙，其实对于StringGrid类，我认为是Delphi自我实现的最好最成功的类之一。这个类我的后面关于StringGrid排序的文章有写得。
TOutlineStrings = class(TStrings) 这是一个很好很强大的Grid类，既然是GRID，当然也是DELPHI自我实现的。有点像DEVExpress有dxTreeList类，功能简单明了。
TCustomComboBoxStrings = class(TStrings) 以前文章曾说过
TMemoStrings = class(TStrings) 以前文章曾说过
TListBoxStrings = class(TStrings) 以前文章曾说过
TTabPageAccess = class(TStrings) 只不过是NoteBook里的TPageAccess的扩展版。
另外，还有一个字符串容器接口:
IStrings = interface(IDispatch)
['{EE05DFE2-5549-11D0-9EA9-0020AF3D82DA}']
function Get_ControlDefault(Index: Integer): OleVariant; safecall;
procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
function Count: Integer; safecall;
function Get_Item(Index: Integer): OleVariant; safecall;
procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
procedure Remove(Index: Integer); safecall;
procedure Clear; safecall;
function Add(Item: OleVariant): Integer; safecall;
function _NewEnum: IUnknown; safecall;
property ControlDefault[Index: Integer]: OleVariant read Get_ControlDefault write Set_ControlDefault; default;
property Item[Index: Integer]: OleVariant read Get_Item write Set_Item;
end;
以接口的方式提供Strings相关的服务.
还有一适配器接口:
IStringsAdapter = interface
['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
procedure ReferenceStrings(S: TStrings);
procedure ReleaseStrings;
end;
为所有的TStrings提供一个引用服务，最终调用结果比如：OleStrings := Strings.StringsAdapter as IStrings;OleStrings操作的最终是StringsAdapter的内部TStrings对象.
我在想，设计这样的兼容性高的类，当时R&D小组是如何做到的？第一，无外乎相当深的编程经验。第二，无外乎相当深的设计经验。
TStringS的类成功，在于它把类的原型模式（其实就是继承,当然不光是抽象方法，虚拟方法的设计也相当的重要）发挥到淋漓尽致.
继续看:
TObject = class
constructor Create;
procedure Free;
class function InitInstance(Instance: Pointer): TObject;
procedure CleanupInstance;
function ClassType: TClass;
class function ClassName: ShortString;
class function ClassNameIs(const Name: string): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
class function MethodAddress(const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
function FieldAddress(const Name: ShortString): Pointer;
function GetInterface(const IID: TGUID; out Obj): Boolean;
class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
class function GetInterfaceTable: PInterfaceTable;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; virtual;
procedure AfterConstruction; virtual;
procedure BeforeDestruction; virtual;
procedure Dispatch(var Message); virtual;
procedure DefaultHandler(var Message); virtual;
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
destructor Destroy; virtual;
end;
我相信，有一定经验基础的DELPHI程序员，对TObject类已经研究过无数遍。可以看到，所有的类方法（也只有方法）都是公开的。并且使用了三个关键字:class,constructor,destructor来描述类方法。
另外这里几个虚拟方法，给开发人员很大的想象并且可发挥空间。这个类在system.pas里，他的编译选项和其他的单元不同:
$(LIB)\system.dcu: sys\system.pas sys\sysinit.pas sys\getmem.inc
$(DCC) sys\system -m -y -z $(RTLDEBUG) -n$(LIB) 这编译选项-y -m 就是DCC32。EXE特别的关键字。
对于Contructor和destructor方法的认识请参看：_ClassCreate和_ClassDestroy,可以看到Contructor最终是有返回值的，是Instance(当然在不出错的情况下)，这意味着constructor是function，再看：
procedure _ClassDestroy(Instance: TObject);
begin
Instance.FreeInstance;
end;
很明显是procedure没有返回值，这也很合理。所以destructor相当于最后调用的procedure方法，只是这个方法在根类就是虚拟动态的了Contructor不是）.
作为根类，提供四类信息：类内存分配及初始化服务，类的方法、接口查询识别的服务，虚拟、动态方法查询及消息查询服务，异常处理和AfterConstruction、BeforeDestruction方法。
把这个类放到设计模式来讲，其实不太合适，因为他太全局的,它的重要性已经超越了设计模式的界限。他太重要了，他是所有设计模式的根源，所有设计模式具体的实现都得靠他提供的基本性质。比如继承，比如接口服务等。
继续看TStream：
TStream = class(TObject)
private
function GetPosition: Int64;
procedure SetPosition(const Pos: Int64);
procedure SetSize64(const NewSize: Int64);
protected
function GetSize: Int64; virtual;
procedure SetSize(NewSize: Longint); overload; virtual;
procedure SetSize(const NewSize: Int64); overload; virtual;
public
function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;
procedure ReadBuffer(var Buffer; Count: Longint);
procedure WriteBuffer(const Buffer; Count: Longint);
function CopyFrom(Source: TStream; Count: Int64): Int64;
function ReadComponent(Instance: TComponent): TComponent;
function ReadComponentRes(Instance: TComponent): TComponent;
procedure WriteComponent(Instance: TComponent);
procedure WriteComponentRes(const ResName: string; Instance: TComponent);
procedure WriteDescendent(Instance, Ancestor: TComponent);
procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
procedure WriteResourceHeader(const ResName: string; out FixupInfo: Integer);
procedure FixupResourceHeader(FixupInfo: Integer);
procedure ReadResHeader;
property Position: Int64 read GetPosition write SetPosition;
property Size: Int64 read GetSize write SetSize64;
end;
可以看到TStream与TStrings设计手法很多相似之处，也是个抽象类，有两抽象方法：
function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
其中：
function Seek(Offset: Longint; Origin: Word): Longint; overload; virtual;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; virtual;
虽然不是虚拟方法，但是继承类必须至少实现其中之一个，另一个则会调用已经实现那个函数。(参看源码)
这样说来，也就是三个抽象方法。这三个抽象方法其实是：写流，读流，取流及大小.(取大小:Seek(0, soEnd));
对流的实现几个类也有好多：
TCustomZlibStream = class(TStream) 作为ZLIB解压和加压的父类流，只提供基本功能，如过程相关事件
THandleStream = class(TStream) 这是个句柄流，其实已经和文件句柄绑定了，既然与文件相关，不知道这里为什么不一起放到TFileStream里去？
TCustomMemoryStream = class(TStream) 内存流，最简单的流
TStringStream = class(TStream) 字符串流,这个主要针对大长字符串的使用，一般情况下很少使用
TIdMultiPartFormDataStream = class(TStream)
TIdStream = class(TStream)
TIdTCPStream = class(TStream)
TOleStream = class(TStream)
TBlobStream = class(TStream)
TIBBlobStream = class(TStream)
TIBDSBlobStream = class(TStream)
TWinSocketStream = class(TStream)
TDOMIStreamAdapter = class(TStream)
TdomWideStringStream = class(TStream)
TConversionStream = class(TStream)
TWebRequestStream = class(TStream)
TAggregatedStream = class(TStream)
继续看TDockTree：
TDockTree = class(TInterfacedObject, IDockManager)
private
FBorderWidth: Integer;
FBrush: TBrush;
FDockSite: TWinControl;
FGrabberSize: Integer;
FGrabbersOnTop: Boolean;
FOldRect: TRect;
FOldWndProc: TWndMethod;
FReplacementZone: TDockZone;
FScaleBy: Double;
FShiftScaleOrient: TDockOrientation;
FShiftBy: Integer;
FSizePos: TPoint;
FSizingDC: HDC;
FSizingWnd: HWND;
FSizingZone: TDockZone;
FTopZone: TDockZone;
FTopXYLimit: Integer;
FUpdateCount: Integer;
FVersion: Integer;
FRelativeSizes: Boolean;
procedure ControlVisibilityChanged(Control: TControl; Visible: Boolean);
function ActualSize(const RelativeSize, Reference: Integer): Integer;
function RelativeSize(const ActualSize, Reference: Integer): Integer;
procedure DrawSizeSplitter;
function FindControlZone(Control: TControl): TDockZone;
procedure ForEachAt(Zone: TDockZone; Proc: TForEachZoneProc);
function GetNextLimit(AZone: TDockZone): Integer;
procedure InsertNewParent(NewZone, SiblingZone: TDockZone;
ParentOrientation: TDockOrientation; InsertLast: Boolean);
procedure InsertSibling(NewZone, SiblingZone: TDockZone; InsertLast: Boolean);
function InternalHitTest(const MousePos: TPoint;
out HTFlag: Integer): TDockZone;
procedure PruneZone(Zone: TDockZone);
procedure RemoveZone(Zone: TDockZone);
procedure ScaleZone(Zone: TDockZone);
procedure SetNewBounds(Zone: TDockZone);
procedure ShiftZone(Zone: TDockZone);
procedure SplitterMouseDown(OnZone: TDockZone; MousePos: TPoint);
procedure SplitterMouseUp;
procedure UpdateZone(Zone: TDockZone);
procedure WindowProc(var Message: TMessage);
protected
procedure AdjustDockRect(Control: TControl; var ARect: TRect); virtual;
procedure AdjustFrameRect(Control: TControl; var ARect: TRect); virtual;
procedure BeginUpdate;
procedure EndUpdate;
function FindControlAtPos(const Pos: TPoint): TControl;
procedure GetControlBounds(Control: TControl; out CtlBounds: TRect);
function HitTest(const MousePos: TPoint; out HTFlag: Integer): TControl; virtual;
procedure InsertControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl); virtual;
procedure LoadFromStream(Stream: TStream); virtual;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer; var Handled: Boolean); virtual;
procedure MouseMove(Shift: TShiftState; X, Y: Integer;
var Handled: Boolean); virtual;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer; var Handled: Boolean); virtual;
procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect); virtual;
procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
var DockRect: TRect); virtual;
function ReferenceFromOrient(const Orient: TDockOrientation): Integer; virtual;
procedure RemoveControl(Control: TControl); virtual;
procedure SaveToStream(Stream: TStream); virtual;
procedure SetReplacingControl(Control: TControl);
procedure ShowHint(CursorPos: TPoint; var CursorRect: TRect;
var HintStr: string); virtual;
procedure ResetBounds(Force: Boolean); virtual;
procedure UpdateAll;
procedure WndProc(var Message: TMessage); virtual;
function ZoneCaptionHitTest(const Zone: TDockZone; const MousePos: TPoint;
var HTFlag: Integer): Boolean; virtual;
property DockSite: TWinControl read FDockSite write FDockSite;
property RelativeSizes: Boolean read FRelativeSizes write FRelativeSizes;
property TopZone: TDockZone read FTopZone;
public
constructor Create(DockSite: TWinControl); virtual;
destructor Destroy; override;
procedure PaintSite(DC: HDC); virtual;
end;
继续看TCollection：
TCollection = class(TPersistent)
private
FItemClass: TCollectionItemClass;
FItems: TList;
FUpdateCount: Integer;
FNextID: Integer;
FPropName: string;
function GetCapacity: Integer;
function GetCount: Integer;
function GetPropName: string;
procedure InsertItem(Item: TCollectionItem);
procedure RemoveItem(Item: TCollectionItem);
procedure SetCapacity(Value: Integer);
protected
procedure Added(var Item: TCollectionItem); virtual; deprecated;
procedure Deleting(Item: TCollectionItem); virtual; deprecated;
property NextID: Integer read FNextID;
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); virtual;
{ Design-time editor support }
function GetAttrCount: Integer; dynamic;
function GetAttr(Index: Integer): string; dynamic;
function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
procedure Changed;
function GetItem(Index: Integer): TCollectionItem;
procedure SetItem(Index: Integer; Value: TCollectionItem);
procedure SetItemName(Item: TCollectionItem); virtual;
procedure Update(Item: TCollectionItem); virtual;
property PropName: string read GetPropName write FPropName;
property UpdateCount: Integer read FUpdateCount;
public
constructor Create(ItemClass: TCollectionItemClass);
destructor Destroy; override;
function Owner: TPersistent;
function Add: TCollectionItem;
procedure Assign(Source: TPersistent); override;
procedure BeginUpdate; virtual;
procedure Clear;
procedure Delete(Index: Integer);
procedure EndUpdate; virtual;
function FindItemID(ID: Integer): TCollectionItem;
function GetEnumerator: TCollectionEnumerator;
function GetNamePath: string; override;
function Insert(Index: Integer): TCollectionItem;
property Capacity: Integer read GetCapacity write SetCapacity;
property Count: Integer read GetCount;
property ItemClass: TCollectionItemClass read FItemClass;
property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
end;
继续看TImageList：
TImageList = class(TDragImageList)
published
property BlendColor;
property BkColor;
property AllocBy;
property DrawingStyle;
property Height;
property ImageType;
property Masked;
property OnChange;
property ShareImages;
property Width;
end;
继续看TIcon：
TIcon = class(TGraphic)
private
FImage: TIconImage;
FRequestedSize: TPoint;
function GetHandle: HICON;
procedure HandleNeeded;
procedure ImageNeeded;
procedure NewImage(NewHandle: HICON; NewImage: TMemoryStream);
procedure SetHandle(Value: HICON);
protected
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
function GetEmpty: Boolean; override;
function GetHeight: Integer; override;
function GetWidth: Integer; override;
procedure SetHeight(Value: Integer); override;
procedure SetTransparent(Value: Boolean); override;
procedure SetWidth(Value: Integer); override;
public
constructor Create; override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function HandleAllocated: Boolean;
procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
APalette: HPALETTE); override;
procedure LoadFromResourceName(Instance: THandle; const ResName: String);
{$IFDEF MSWINDOWS}
procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
{$ENDIF}
procedure LoadFromStream(Stream: TStream); override;
function ReleaseHandle: HICON;
procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
var APalette: HPALETTE); override;
procedure SaveToStream(Stream: TStream); override;
procedure SetSize(AWidth, AHeight: Integer); override;
property Handle: HICON read GetHandle write SetHandle;
end;
继续看TComObject：
TComObject = class(TObject, IUnknown, ISupportErrorInfo)
private
FController: Pointer;
FFactory: TComObjectFactory;
FNonCountedObject: Boolean;
FRefCount: Integer;
FServerExceptionHandler: IServerExceptionHandler;
function GetController: IUnknown;
protected
{ IUnknown }
function IUnknown.QueryInterface = ObjQueryInterface;
function IUnknown._AddRef = ObjAddRef;
function IUnknown._Release = ObjRelease;
{ IUnknown methods for other interfaces }
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ ISupportErrorInfo }
function InterfaceSupportsErrorInfo(const iid: TIID): HResult; stdcall;
public
constructor Create;
constructor CreateAggregated(const Controller: IUnknown);
constructor CreateFromFactory(Factory: TComObjectFactory;
const Controller: IUnknown);
destructor Destroy; override;
procedure Initialize; virtual;
function ObjAddRef: Integer; virtual; stdcall;
function ObjQueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
function ObjRelease: Integer; virtual; stdcall;
{$IFDEF MSWINDOWS}
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; override;
{$ENDIF}
property Controller: IUnknown read GetController;
property Factory: TComObjectFactory read FFactory;
property RefCount: Integer read FRefCount;
property ServerExceptionHandler: IServerExceptionHandler
read FServerExceptionHandler write FServerExceptionHandler;
end;
{$EXTERNALSYM TComObject}
继续看TAutoObject：
TAutoObject = class(TTypedComObject, IDispatch)
private
FEventSink: IUnknown;
FAutoFactory: TAutoObjectFactory;
protected
{ IDispatch }
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; virtual; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; virtual; stdcall;
function GetTypeInfoCount(out Count: Integer): HResult; virtual; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; virtual; stdcall;
{ Other methods }
procedure EventConnect(const Sink: IUnknown; Connecting: Boolean);
procedure EventSinkChanged(const EventSink: IUnknown); virtual;
property AutoFactory: TAutoObjectFactory read FAutoFactory;
property EventSink: IUnknown read FEventSink write FEventSink;
public
procedure Initialize; override;
end;
{$EXTERNALSYM TAutoObject}
最后看TOleControl：
TOleControl = class(TWinControl, IUnknown, IOleClientSite,
IOleControlSite, IOleInPlaceSite, IOleInPlaceFrame, IDispatch,
IPropertyNotifySink, ISimpleFrameSite, IServiceProvider)
private
FControlData: PControlData;
FRefCount: Longint;
FEventDispatch: TEventDispatch;
FObjectData: HGlobal;
FOleObject: IOleObject;
FPersistStream: IPersistStreamInit;
FOleControl: IOleControl;
FControlDispatch: IDispatch;
FPropBrowsing: IPerPropertyBrowsing;
FOleInPlaceObject: IOleInPlaceObject;
FOleInPlaceActiveObject: IOleInPlaceActiveObject;
FPropConnection: Longint;
FEventsConnection: Longint;
FMiscStatus: Longint;
FFonts: TList;
FPictures: TList;
FUpdatingPictures: Boolean;
FUpdatingColor: Boolean;
FUpdatingFont: Boolean;
FUpdatingEnabled: Boolean;
FServiceQuery: TServiceQuery;
FControlInfo: TControlInfo;
protected
procedure StandardEvent(DispID: TDispID; var Params: TDispParams); virtual;
procedure InvokeEvent(DispID: TDispID; var Params: TDispParams); virtual;
{ IUnknown }
function QueryInterface(const IID: TGUID; out Obj): HResult; override;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ IOleClientSite }
function SaveObject: HResult; stdcall;
function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
out mk: IMoniker): HResult; stdcall;
function GetContainer(out container: IOleContainer): HResult; stdcall;
function ShowObject: HResult; stdcall;
function OnShowWindow(fShow: BOOL): HResult; stdcall;
function RequestNewObjectLayout: HResult; stdcall;
{ IOleControlSite }
function OnControlInfoChanged: HResult; stdcall;
function LockInPlaceActive(fLock: BOOL): HResult; stdcall;
function GetExtendedControl(out disp: IDispatch): HResult; stdcall;
function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF;
flags: Longint): HResult; stdcall;
function IOleControlSite.TranslateAccelerator = OleControlSite_TranslateAccelerator;
function OleControlSite_TranslateAccelerator(msg: PMsg;
grfModifiers: Longint): HResult; stdcall;
function OnFocus(fGotFocus: BOOL): HResult; stdcall;
function ShowPropertyFrame: HResult; stdcall;
{ IOleWindow }
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
{ IOleInPlaceSite }
function IOleInPlaceSite.GetWindow = OleInPlaceSite_GetWindow;
function OleInPlaceSite_GetWindow(out wnd: HWnd): HResult; stdcall;
function CanInPlaceActivate: HResult; stdcall;
function OnInPlaceActivate: HResult; stdcall;
function OnUIActivate: HResult; stdcall;
function GetWindowContext(out frame: IOleInPlaceFrame;
out doc: IOleInPlaceUIWindow; out rcPosRect: TRect;
out rcClipRect: TRect; out frameInfo: TOleInPlaceFrameInfo): HResult;
stdcall;
function Scroll(scrollExtent: TPoint): HResult; stdcall;
function OnUIDeactivate(fUndoable: BOOL): HResult; stdcall;
function OnInPlaceDeactivate: HResult; stdcall;
function DiscardUndoState: HResult; stdcall;
function DeactivateAndUndo: HResult; stdcall;
function OnPosRectChange(const rcPosRect: TRect): HResult; stdcall;
{ IOleInPlaceUIWindow }
function GetBorder(out rectBorder: TRect): HResult; stdcall;
function RequestBorderSpace(const borderwidths: TRect): HResult; stdcall;
function SetBorderSpace(pborderwidths: PRect): HResult; stdcall;
function SetActiveObject(const activeObject: IOleInPlaceActiveObject;
pszObjName: POleStr): HResult; stdcall;
{ IOleInPlaceFrame }
function IOleInPlaceFrame.GetWindow = OleInPlaceFrame_GetWindow;
function OleInPlaceFrame_GetWindow(out wnd: HWnd): HResult; stdcall;
function InsertMenus(hmenuShared: HMenu;
var menuWidths: TOleMenuGroupWidths): HResult; stdcall;
function SetMenu(hmenuShared: HMenu; holemenu: HMenu;
hwndActiveObject: HWnd): HResult; stdcall;
function RemoveMenus(hmenuShared: HMenu): HResult; stdcall;
function SetStatusText(pszStatusText: POleStr): HResult; stdcall;
function EnableModeless(fEnable: BOOL): HResult; stdcall;
function IOleInPlaceFrame.TranslateAccelerator = OleInPlaceFrame_TranslateAccelerator;
function OleInPlaceFrame_TranslateAccelerator(var msg: TMsg;
wID: Word): HResult; stdcall;
{ IDispatch }
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
{ ISimpleFrameSite }
function PreMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
out res: Integer; out Cookie: Longint): HResult; stdcall;
function PostMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
out res: Integer; Cookie: Longint): HResult; stdcall;
{ IServiceProvider }
function QueryService(const rsid, iid: TGuid; out obj): HResult; stdcall;
{ IPropertyNotifySink }
function OnChanged(dispid: TDispID): HResult; virtual; stdcall;
function OnRequestEdit(dispid: TDispID): HResult; virtual; stdcall;
....
public
...
procedure DefaultHandler(var Message); override;
procedure DoObjectVerb(Verb: Integer);
function GetEnumPropDesc(DispID: Integer): TEnumPropDesc;
function GetHelpContext(Member: string; var HelpCtx: Integer;
var HelpFile: string): Boolean;
procedure GetObjectVerbs(List: TStrings);
...
end;
873
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
