核心库类之TComponent类

 VCL Framework 的核心组件基础类TComponent，提供的基础服务：
   *作为基础根组件类以及基础组建管理功能
   *可同时扮演Container组件和单一组件的功能
   *基础组件互动通知功能（Notification）
   *同时提供可视化和非可视化组件构架基础

TComponent类定义了组件的许多核心元素，TComponent类的一个核心特性是所有权的定义。当建立一个组件时，它可以被赋给一个所有者组件，同时也要负责消除这个组建。所有每个组件都有一个所有者，并还可以做为其他组件的所有者。

参 看70行，如果建立一个组件并且将它赋给某个所有者，那么它将被添加 到组件列表（Insertcomponent）,并使用components数组属性来访问。特定组件有个owner，并通过 componentindex属性了解自己在所有者组件列表中的位置。最后，所有者的析构器将负责其所有对象的解除，此时，可调用 destroycomponents。

改变所有者（owner），为了改变组件的所有者，可以通过调用所有者自己的insertcomponent与removecomponent对象方法来影响该值（将当前组件做为参数传递）

procedure changeowner(component, newowner:   TComponent);

begin

   component.owner.removecomponent(component);

  newowner.insertcomponent(component);

end;

可定制的tag属性

   tag属性是一个奇怪的属性，因为它根本就没有什么效果，它只是一个附加内存地址，出现在每个组件类中，用于存储专用的值。它存储的种类及其使用方式完全由用户来决定。

1.作为基础根组件类以及基础组建管理功能
TComponent作为组件类的根类自然需要声明虚拟构造函数和虚拟析构函数以便让派生类可以改写。

public
    constructor Create(AOwner: TComponent); virtual;
    destructor Destroy; override;

 

constructor TComponent.Create(AOwner: TComponent);
begin
  FComponentStyle : =  [csInheritable];
   if  AOwner  <>  nil  then  AOwner.InsertComponent(Self);
end ;

 

 1 destructor TComponent.Destroy;
 2 begin
 3   Destroying;
 4    if  FFreeNotifies  <>  nil  then
 5   begin
 6      while  Assigned(FFreeNotifies)  and  (FFreeNotifies.Count  >   0 )  do
 7       TComponent(FFreeNotifies[FFreeNotifies.Count  -   1 ]).Notification(Self, opRemove);
 8     FreeAndNil(FFreeNotifies);
 9    end ;
10   DestroyComponents;
11    if  FOwner  <>  nil  then  FOwner.RemoveComponent(Self);
12   inherited Destroy;
13 end ;

 tcomponent实现了基础组件管理服务，这些方法是InsertComponent、RemoveComponent、components等相关特性。
2.可同时扮演Container组件和单一组件的功能

TComponent  =  class(TPersistent, IInterface, IInterfaceComponentReference)
   private
    FOwner: TComponent; // 父代对象
    FName: TComponentName;
    FTag: Longint;
    FComponents: TList; // 存储所有它管理的子组件

 

3.基础组件互动通知功能（Notification）
采用了Notify设计模式来管理子组件，在 TComponent的构造函数中调用了父代对象的InsertComponent来通知一个新的TComponent对象的加入。在005行中把新的子 组件加入到FComponents中，在009行中调用Notification通知FComponents中的每个组件现在有新的组件加入了。

 1 procedure TComponent.InsertComponent(AComponent: TComponent);
 2 begin
 3   AComponent.ValidateContainer(Self);
 4   ValidateRename(AComponent,  ' ', AComponent.FName);
 5   Insert(AComponent);
 6   AComponent.SetReference( True );
 7    if  csDesigning in ComponentState  then
 8     AComponent.SetDesigning( True );
 9   Notification(AComponent, opInsert);
10 end ;
11
12 procedure TComponent.Insert(AComponent: TComponent);
13 begin
14    if  FComponents  =  nil  then  FComponents : =  TList.Create;
15   FComponents.Add(AComponent);
16   AComponent.FOwner : =  Self;
17 end ;
18
19 procedure TComponent.Notification(AComponent: TComponent;
20   Operation: TOperation);
21 var
22   I:  Integer ;
23 begin
24    if  (Operation  =  opRemove)  and  (AComponent  <>  nil)  then
25     RemoveFreeNotification(AComponent);
26    if  FComponents  <>  nil  then
27   begin
28     I : =  FComponents.Count  -   1 ;
29      while  I  >=   0   do
30     begin
31       TComponent(FComponents[I]).Notification(AComponent, Operation);
32       Dec(I);
33        if  I  >=  FComponents.Count  then
34         I : =  FComponents.Count  -   1 ;
35      end ;
36    end ;
37 end ;

     TComponent的Notitication声明成虚拟方法。
TComponent另一个基础管理组件服务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;
    FComponents : =  nil;
   end ;
end ;

 

procedure TComponent.DefineProperties(Filer: TFiler);
var
  Ancestor: TComponent;
  Info: Longint;
begin
  Info : =   0 ;
  Ancestor : =  TComponent(Filer.Ancestor);
   if  Ancestor  <>  nil  then  Info : =  Ancestor.FDesignInfo;
  Filer.DefineProperty( ' Left', ReadLeft, WriteLeft,
    LongRec(FDesignInfo).Lo  <>  LongRec(Info).Lo);
  Filer.DefineProperty( ' Top', ReadTop, WriteTop,
    LongRec(FDesignInfo).Hi  <>  LongRec(Info).Hi);
end ;

 

  1 TComponent  =  class(TPersistent, IInterface, IInterfaceComponentReference)
  2    private
  3     FOwner: TComponent;
  4     FName: TComponentName;
  5     FTag: Longint;
  6     FComponents: TList;
  7     FFreeNotifies: TList;
  8     FDesignInfo: Longint;
  9     FComponentState: TComponentState;
 10
 11     FVCLComObject: Pointer;
 12      function  GetComObject: IUnknown;
 13
 14      function  GetComponent(AIndex:  Integer ): TComponent;
 15      function  GetComponentCount:  Integer ;
 16      function  GetComponentIndex:  Integer ;
 17     procedure Insert(AComponent: TComponent);
 18     procedure ReadLeft(Reader: TReader);
 19     procedure ReadTop(Reader: TReader);
 20     procedure Remove(AComponent: TComponent);
 21     procedure RemoveNotification(AComponent: TComponent);
 22     procedure SetComponentIndex(Value:  Integer );
 23     procedure SetReference(Enable:  Boolean );
 24     procedure WriteLeft(Writer: TWriter);
 25     procedure WriteTop(Writer: TWriter);
 26     { IInterfaceComponentReference }
 27      function  IInterfaceComponentReference.GetComponent  =  IntfGetComponent;
 28      function  IntfGetComponent: TComponent;
 29   protected
 30     FComponentStyle: TComponentStyle;
 31     procedure ChangeName( const  NewName: TComponentName);
 32     procedure DefineProperties(Filer: TFiler); override;
 33     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
 34      function  GetChildOwner: TComponent; dynamic;
 35      function  GetChildParent: TComponent; dynamic;
 36      function  GetOwner: TPersistent; override;
 37     procedure Loaded; virtual;
 38     procedure Notification(AComponent: TComponent;
 39       Operation: TOperation); virtual;
 40     procedure PaletteCreated; dynamic;
 41     procedure ReadState(Reader: TReader); virtual;
 42     procedure SetAncestor(Value:  Boolean );
 43     procedure SetDesigning(Value:  Boolean ; SetChildren:  Boolean   =   True );
 44     procedure SetInline(Value:  Boolean );
 45     procedure SetDesignInstance(Value:  Boolean );
 46     procedure SetName( const  NewName: TComponentName); virtual;
 47     procedure SetChildOrder(Child: TComponent; Order:  Integer ); dynamic;
 48     procedure SetParentComponent(Value: TComponent); dynamic;
 49     procedure Updating; dynamic;
 50     procedure Updated; dynamic;
 51     class procedure UpdateRegistry(Register:  Boolean ;  const  ClassID, ProgID:  string ); virtual;
 52     procedure ValidateRename(AComponent: TComponent;
 53        const  CurName, NewName:  string ); virtual;
 54     procedure ValidateContainer(AComponent: TComponent); dynamic;
 55     procedure ValidateInsert(AComponent: TComponent); dynamic;
 56     procedure WriteState(Writer: TWriter); virtual;
 57     { IInterface }
 58      function  QueryInterface( const  IID: TGUID; out Obj): HResult; virtual; stdcall;
 59      function  _AddRef:  Integer ; stdcall;
 60      function  _Release:  Integer ; stdcall;
 61
 62     { IDispatch }
 63      function  GetTypeInfoCount(out Count:  Integer ): HResult; stdcall;
 64      function  GetTypeInfo(Index, LocaleID:  Integer ; out TypeInfo): HResult; stdcall;
 65      function  GetIDsOfNames( const  IID: TGUID; Names: Pointer;
 66       NameCount, LocaleID:  Integer ; DispIDs: Pointer): HResult; stdcall;
 67      function  Invoke(DispID:  Integer ;  const  IID: TGUID; LocaleID:  Integer ;
 68       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
 69
 70    public
 71     constructor Create(AOwner: TComponent); virtual;
 72     destructor Destroy; override;
 73     procedure BeforeDestruction; override;
 74     procedure DestroyComponents;
 75     procedure Destroying;
 76      function  ExecuteAction(Action: TBasicAction):  Boolean ; dynamic;
 77      function  FindComponent( const  AName:  string ): TComponent;
 78     procedure FreeNotification(AComponent: TComponent);
 79     procedure RemoveFreeNotification(AComponent: TComponent);
 80
 81     procedure FreeOnRelease;
 82
 83      function  GetParentComponent: TComponent; dynamic;
 84      function  GetNamePath:  string ; override;
 85      function  HasParent:  Boolean ; dynamic;
 86     procedure InsertComponent(AComponent: TComponent);
 87     procedure RemoveComponent(AComponent: TComponent);
 88     procedure SetSubComponent(IsSubComponent:  Boolean );
 89      function  SafeCallException(ExceptObject: TObject;
 90       ExceptAddr: Pointer): HResult; override;
 91      function  UpdateAction(Action: TBasicAction):  Boolean ; dynamic;
 92      function  IsImplementorOf( const  I: IInterface):  Boolean ;
 93      function  ReferenceInterface( const  I: IInterface; Operation: TOperation):  Boolean ;
 94
 95      property  ComObject: IUnknown read GetComObject;
 96
 97      property  Components[Index:  Integer ]: TComponent read GetComponent;
 98      property  ComponentCount:  Integer  read GetComponentCount;
 99      property  ComponentIndex:  Integer  read GetComponentIndex write SetComponentIndex;
100      property  ComponentState: TComponentState read FComponentState;
101      property  ComponentStyle: TComponentStyle read FComponentStyle;
102      property  DesignInfo: Longint read FDesignInfo write FDesignInfo;
103      property  Owner: TComponent read FOwner;
104
105      property  VCLComObject: Pointer read FVCLComObject write FVCLComObject;
106
107   published
108      property  Name: TComponentName read FName write SetName stored  False ;
109      property  Tag: Longint read FTag write FTag default  0 ;
110    end ;