核心库类之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;


 1destructor TComponent.Destroy;
 2begin
 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;
13end;

 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中的每个组件现在有新的组件加入了。

 1procedure TComponent.InsertComponent(AComponent: TComponent);
 2begin
 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);
10end;
11
12procedure TComponent.Insert(AComponent: TComponent);
13begin
14  if FComponents = nil then FComponents := TList.Create;
15  FComponents.Add(AComponent);
16  AComponent.FOwner := Self;
17end;
18
19procedure TComponent.Notification(AComponent: TComponent;
20  Operation: TOperation);
21var
22  I: Integer;
23begin
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;
37end;

     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;

  1TComponent = 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;
posted on 2007-04-11 16:30  左左右右  阅读(1477)  评论(0)    收藏  举报