核心库类之TComponent类

最新推荐文章于 2025-07-26 08:56:34 发布
转载 最新推荐文章于 2025-07-26 08:56:34 发布 · 1.1k 阅读 · 0
标签
#integer #components #设计模式 #string #action
#function
本文介绍了VCL Framework中核心组件TComponent的管理机制，包括组件的所有权定义、基础组件管理和通知功能等。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;
powder111
关注
组件基类TComponent
bambuz的专栏
11-17 943
组件基类TComponent
Delphi之TComponent类
weixin_30652271的博客
12-27 260
TComponent类 TComponent类直接由TPersistent派生。TComponent的独特特征是它的属性能够在设计期间通过ObjectInspector来控制，能够拥有其他组件。非可视组件也是从TComponent派生的，因此它们也继承了在设计期间可以被控制的能力。TComponent派生的非可视对象的典型例子是TTimer组件。TTimer组件是不可视组件，但它仍可以在组件面板...
技术演进中的开发沉思-46 DELPHI VCL系列：TComponent 的设计智慧
最新发布
你的天空阅读专栏
07-26 900
摘要：本文回顾了Delphi的VCL框架设计哲学，重点分析了TComponent组件的核心特性。作者通过亲身经历对比了VCL与其他开发框架的差异，指出VCL"所见即所得"的设计理念和"预制件"架构的前瞻性。TComponent作为所有组件的基类，实现了四大创新：组件容器化、自动通知机制、可视化/非可视化统一管理，以及与IDE的深度集成。这些设计使开发者能像搭积木一样快速构建应用，将复杂性隐藏在框架内部，提供简单直观的开发体验。文章认为VCL最宝贵的不是技术本身，而是其
Delphi容器类之---TList、TObjectList、TComponentList、TClassList的使用
ghs79的专栏
03-21 2325
转载自：http://blog.csdn.net/iseekcode/article/details/4922001 从Delphi5开始VCL中增加了新的Contnrs单元，单元中定义了8个新的类，全部都是基于标准的TList类。 TList　　　　　　　　　　　　　　　　　　　　　　　 　　TList类实际上就是一个可以存储指针的容器类，提供了一系列的方法和属性来
VCL类学习之(七) TComponent
记录成长的每一步
12-29 2135
TComponent is the common ancestor of all component classes.UnitClassesDescriptionTComponent is the base class for all components. TComponent implements the following features:Components are
自定义控件最简单的例子
ksrsoft的专栏
03-30 1804
h文件 class PACKAGE timagelist1 : public TImageList { private: protected: public:         __fastcall timagelist1(TComponent* Owner); __published: };   cpp文件 static inline void ValidCtrCheck(t
delphi TComponent类 2
流年~~
04-09 3610
学习DELPHI最好的方法是看DELPHI的VCL原代码爱看他的机制本文就类TComponent的原代码来看他的机制. { TComponent } constructor TComponent.Create(AOwner: TComponent); begin FComponentStyle := [csInheritable]; if AOwner <> nil then
通过原代码学习TComponent类的机制(1)
zjybestzjybest的专栏
05-23 1012
   学习DELPHI最好的方法是看DELPHI的VCL原代码爱看他的机制本文就类TComponent的原代码来看他的机制.{ TComponent }constructor TComponent.Create(AOwner: TComponent);begin  FComponentStyle := [csInheritable];  if AOwner end;procedure TCom
delphi接口问题——当类继承自TComponent和TObject
guanguan241的专栏
11-23 1635
因为TComponent已经实现了接口IInterface，所以它的子类，继承接口之后不需要再重新实现引用计数之类的方法。而直接继承自TObject的类则没有，所以要实现接口，必须实现IInterface接口中的引用计数等方法，或者可以直接继承system单元中的TInterfacedObject(已经将这些方法实现)。         但是要注意，XX类如果直接继承自TInterfacedOb
乱翻TComponent
weixin_30502157的博客
12-08 93
请各位慎重,本人水平很差,下面所述很有可能不正确. TComponent是所有组件的基类,派生至TPersistent. 方法解析:constructor TComponent.Create(AOwner: TComponent); begin FComponentStyle := [csInheritable];//可继承 if AOwner <> nil then A...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值