>您想要或需要一个能够容纳多个子组件的自定义组件.
>这些子组件将由该自定义组件创建.
>子组件需要能够在代码中通过其名称引用为设计时的任何正常组件;因此不是Form.CustomComponent.Children [0],而是Form.Child1.
>因此,子组件需要声明 – 并因此添加到 – 模块的源文件(Form,Frame或DataModule).
>子组件将由默认IDE集合编辑器管理.
>因此,孩子需要完全包装到TCollectionItem中.

评估当前代码

你已经很顺利了,但除了你的问题,代码还有一些需要改进的地方：

>您创建的集合永远不会被释放.
>每次显示集合编辑器时都会创建一个新集合.
>如果从TreeView中删除子项,则旧的相应CollectionItem将保留,从而生成AV.
>设计时间和运行时代码不分割.

解

以下是代码的重写工作版本,其中包含以下更改：

>特殊组件称为Master,因为Parent与Delphi的Parent混淆太多(已经有两种类型).因此,一个孩子被称为奴隶.
> Slave被保存在TComponentList(单元Contnrs)中,以便在单个从站销毁时自动更新列表. ComponentList拥有从属.
>对于每个Master,只创建一个Collection.这些Master-Collection组合保存在单独的TStockItems ObjectList中.列表拥有库存项目,并在“完成”部分中释放列表.
>实现GetNamePath,以便在Object Inspector中将slave显示为Slave1,而不是SlaveWrappers(0).
>为TSlaveWrapper类的事件添加了额外的属性编辑器.不知何故,默认TMethodProperty的GetFormMethodName会导致您获得的错误.原因将在Designer.GetObjectName中,但我不确切知道原因.现在GetFormMethodName被覆盖,这解决了您的问题中的问题.

备注

按集合中项目的顺序(使用集合编辑器的箭头按钮)所做的更改尚未保留.试着让自己实现.

在TreeView中,每个Slave现在都是Master的直接子节点,而不是Slaves属性的子节点,正如通常在集合中看到的那样：

为了实现这一点,我认为TSlaves应该来自TPersistent,并且ComponentList将被包含在其中.这肯定是另一个不错的尝试.

组件代码

unit MasterSlave;
 
interface
 
uses
  Classes,Contnrs;
 
type
  TMaster = class;
 
  TSlave = class(TComponent)
  private
    FMaster: TMaster;
    FOnTest: TNotifyEvent;
    procedure SetMaster(Value: TMaster);
  protected
    procedure SetParentComponent(AParent: TComponent); override;
  public
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    property Master: TMaster read FMaster write SetMaster;
  published
    property OnTest: TNotifyEvent read FOnTest write FOnTest;
  end;
 
  TSlaves = class(TComponentList)
  private
    function GetItem(Index: Integer): TSlave;
    procedure SetItem(Index: Integer; Value: TSlave);
  public
    property Items[Index: Integer]: TSlave read GetItem write SetItem; default;
  end;
 
  TMaster = class(TComponent)
  private
    FSlaves: TSlaves;
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Slaves: TSlaves read FSlaves;
  end;
 
implementation
 
{ TSlave }
 
function TSlave.GetParentComponent: TComponent;
begin
  Result := FMaster;
end;
 
function TSlave.HasParent: Boolean;
begin
  Result := FMaster <> nil;
end;
 
procedure TSlave.SetMaster(Value: TMaster);
begin
  if FMaster <> Value then
  begin
    if FMaster <> nil then
      FMaster.FSlaves.Remove(Self);
    FMaster := Value;
    if FMaster <> nil then
      FMaster.FSlaves.Add(Self);
  end;
end;
 
procedure TSlave.SetParentComponent(AParent: TComponent);
begin
  if AParent is TMaster then
    SetMaster(TMaster(AParent));
end;
 
{ TSlaves }
 
function TSlaves.GetItem(Index: Integer): TSlave;
begin
  Result := TSlave(inherited Items[Index]);
end;
 
procedure TSlaves.SetItem(Index: Integer; Value: TSlave);
begin
  inherited Items[Index] := Value;
end;
 
{ TMaster }
 
constructor TMaster.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSlaves := TSlaves.Create(True);
end;
 
destructor TMaster.Destroy;
begin
  FSlaves.Free;
  inherited Destroy;
end;
 
procedure TMaster.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
begin
  for I := 0 to FSlaves.Count - 1 do
    Proc(FSlaves[I]);
end;
 
end.

编辑代码

unit MasterSlaveEdit;
 
interface
 
uses
  Classes,SysUtils,MasterSlave,Contnrs,DesignIntf,ColnEdit;
 
type
  TMasterEditor = class(TComponentEditor)
  private
    function Master: TMaster;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): String; override;
    function GetVerbCount: Integer; override;
  end;
 
  TMasterProperty = class(TPropertyEditor)
  private
    function Master: TMaster;
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: String; override;
  end;
 
  TOnTestProperty = class(TMethodProperty)
  private
    function Slave: TSlave;
  public
    function GetFormMethodName: String; override;
  end;
 
  TSlaveWrapper = class(TCollectionItem)
  private
    FSlave: TSlave;
    function GetName: String;
    function GetOnTest: TNotifyEvent;
    procedure SetName(const Value: String);
    procedure SetOnTest(Value: TNotifyEvent);
  protected
    function GetDisplayName: String; override;
  public
    constructor Create(Collection: TCollection); override;
    constructor CreateSlave(Collection: TCollection; ASlave: TSlave);
    destructor Destroy; override;
    function GetNamePath: String; override;
  published
    property Name: String read GetName write SetName;
    property OnTest: TNotifyEvent read GetOnTest write SetOnTest;
  end;
 
  TSlaveWrappers = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TSlaveWrapper;
  public
    property Items[Index: Integer]: TSlaveWrapper read GetItem; default;
  end;
 
implementation
 
type
  TStockItem = class(TComponent)
  protected
    Collection: TSlaveWrappers;
    Designer: IDesigner;
    Master: TMaster;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    destructor Destroy; override;
  end;
 
  TStockItems = class(TObjectList)
  private
    function GetItem(Index: Integer): TStockItem;
  protected
    function CollectionOf(AMaster: TMaster; Designer: IDesigner): TCollection;
    function Find(ACollection: TCollection): TStockItem;
    property Items[Index: Integer]: TStockItem read GetItem;
      default;
  end;
 
var
  FStock: TStockItems = nil;
 
function Stock: TStockItems;
begin
  if FStock = nil then
    FStock := TStockItems.Create(True);
  Result := FStock;
end;
 
{ TStockItem }
 
destructor TStockItem.Destroy;
begin
  Collection.Free;
  inherited Destroy;
end;
 
procedure TStockItem.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  inherited Notification(AComponent,Operation);
  if Operation = opRemove then
    for I := 0 to Collection.Count - 1 do
      if Collection[I].FSlave = AComponent then
      begin
        Collection[I].FSlave := nil;
        Collection.Delete(I);
        Break;
      end;
end;
 
{ TStockItems }
 
function TStockItems.CollectionOf(AMaster: TMaster;
  Designer: IDesigner): TCollection;
var
  I: Integer;
  Item: TStockItem;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Master = AMaster then
    begin
      Result := Items[I].Collection;
      Break;
    end;
  if Result = nil then
  begin
    Item := TStockItem.Create(nil);
    Item.Master := AMaster;
    Item.Designer := Designer;
    Item.Collection := TSlaveWrappers.Create(AMaster,TSlaveWrapper);
    for I := 0 to AMaster.Slaves.Count - 1 do
    begin
      TSlaveWrapper.CreateSlave(Item.Collection,AMaster.Slaves[I]);
      Item.FreeNotification(AMaster.Slaves[I]);
    end;
    Add(Item);
    Result := Item.Collection;
  end;
end;
 
function TStockItems.GetItem(Index: Integer): TStockItem;
begin
  Result := TStockItem(inherited Items[Index]);
end;
 
function TStockItems.Find(ACollection: TCollection): TStockItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Collection = ACollection then
    begin
      Result := Items[I];
      Break;
    end;
end;
 
{ TMasterEditor }
 
procedure TMasterEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: ShowCollectionEditor(Designer,Master,Stock.CollectionOf(Master,Designer),'Slaves');
  end;
end;
 
function TMasterEditor.GetVerb(Index: Integer): String;
begin
  case Index of
    0: Result := 'Edit slaves...';
  else
    Result := '';
  end;
end;
 
function TMasterEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;
 
function TMasterEditor.Master: TMaster;
begin
  Result := TMaster(Component);
end;
 
{ TMasterProperty }
 
procedure TMasterProperty.Edit;
begin
  ShowCollectionEditor(Designer,'Slaves');
end;
 
function TMasterProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;
 
function TMasterProperty.GetValue: String;
begin
  Result := Format('(%s)',[Master.Slaves.ClassName]);
end;
 
function TMasterProperty.Master: TMaster;
begin
  Result := TMaster(GetComponent(0));
end;
 
{ TOnTestProperty }
 
function TOnTestProperty.GetFormMethodName: String;
begin
  Result := Slave.Name + GetTrimmedEventName;
end;
 
function TOnTestProperty.Slave: TSlave;
begin
  Result := TSlaveWrapper(GetComponent(0)).FSlave;
end;
 
{ TSlaveWrapper }
 
constructor TSlaveWrapper.Create(Collection: TCollection);
begin
  CreateSlave(Collection,nil);
end;
 
constructor TSlaveWrapper.CreateSlave(Collection: TCollection; ASlave: TSlave);
var
  Item: TStockItem;
begin
  inherited Create(Collection);
  if ASlave = nil then
  begin
    Item := Stock.Find(Collection);
    FSlave := TSlave.Create(Item.Master.Owner);
    FSlave.Name := Item.Designer.UniqueName(TSlave.ClassName);
    FSlave.Master := Item.Master;
    FSlave.FreeNotification(Item);
  end
  else
    FSlave := ASlave;
end;
 
destructor TSlaveWrapper.Destroy;
begin
  FSlave.Free;
  inherited Destroy;
end;
 
function TSlaveWrapper.GetDisplayName: String;
begin
  Result := Name;
end;
 
function TSlaveWrapper.GetName: String;
begin
  Result := FSlave.Name;
end;
 
function TSlaveWrapper.GetNamePath: String;
begin
  Result := FSlave.GetNamePath;
end;
 
function TSlaveWrapper.GetOnTest: TNotifyEvent;
begin
  Result := FSlave.OnTest;
end;
 
procedure TSlaveWrapper.SetName(const Value: String);
begin
  FSlave.Name := Value;
end;
 
procedure TSlaveWrapper.SetOnTest(Value: TNotifyEvent);
begin
  FSlave.OnTest := Value;
end;
 
{ TSlaveWrappers }
 
function TSlaveWrappers.GetItem(Index: Integer): TSlaveWrapper;
begin
  Result := TSlaveWrapper(inherited Items[Index]);
end;
 
initialization
 
finalization
  FStock.Free;
 
end.

注册码

unit MasterSlaveReg;
 
interface
 
uses
  Classes,MasterSlaveEdit,DesignIntf;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterClass(TSlave);
  RegisterNoIcon([TSlave]);
  RegisterComponents('Samples',[TMaster]);
  RegisterComponentEditor(TMaster,TMasterEditor);
  RegisterPropertyEditor(TypeInfo(TSlaves),TMaster,'Slaves',TMasterProperty);
  RegisterPropertyEditor(TypeInfo(TNotifyEvent),TSlaveWrapper,'OnTest',TOnTestProperty);
end;
 
end.

包裹代码

requires
  rtl,DesignIDE;
 
contains
  MasterSlave in 'MasterSlave.pas',MasterSlaveEdit in 'MasterSlaveEdit.pas',MasterSlaveReg in 'MasterSlaveReg.pas';