delphi - 创建具有命名子组件的组件？

Question

我需要了解码件生成和管理子组件背后的基础知识。我最初通过创建一个 TCollection 来尝试此操作，并尝试为每个 TCollectionItem 命名。但我发现这并不像我希望的那么容易。

所以现在我要再次从头开始这个项目，我希望这次能做对。这些子组件不是可视组件，并且不应该有任何显示或窗口，仅基于 TComponent。包含这些子组件的主组件也将基于TComponent。所以这里没有任何东西是可视的，我不想在我的表单上(在设计时)为每个子组件都有一个小图标。

我希望能够以类似集合的方式维护和管理这些子组件。重要的是，应该创建、命名这些子组件并将其添加到表单源中，就像菜单项一样。这就是这个想法的全部要点，如果它们不能被命名，那么整个想法就失效了。

哦，另一件重要的事情:作为所有子组件的父组件的主组件需要能够将这些子组件保存到 DFM 文件中。

示例:

不要访问这些子项目之一，例如:

MyForm.MyItems[1].DoSomething();

我想做一些类似的事情:

MyForm.MyItem2.DoSomething();

所以我不必依赖于知道每个子项的 ID。

编辑:

我觉得有必要包含我的原始代码，以便可以看到原始集合是如何工作的。这只是从完整单元中剥离的服务器端集合和集合项:

//  Command Collections
//  Goal: Allow entering pre-set commands with unique Name and ID
//  Each command has its own event which is triggered when command is received
//  TODO: Name each collection item as a named component in owner form

  //Determines how commands are displayed in collection editor in design-time
  TJDCmdDisplay = (cdName, cdID, cdCaption, cdIDName, cdIDCaption);

  TJDScktSvrCmdEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
    const Data: TStrings) of object;

  TSvrCommands = class(TCollection)
  private
    fOwner: TPersistent;
    fOnUnknownCommand: TJDScktSvrCmdEvent;
    fDisplay: TJDCmdDisplay;
    function GetItem(Index: Integer): TSvrCommand;
    procedure SetItem(Index: Integer; Value: TSvrCommand);
    procedure SetDisplay(const Value: TJDCmdDisplay);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy;
    procedure DoCommand(const Socket: TJDServerClientSocket;
      const Cmd: Integer; const Data: TStrings);
    function Add: TSvrCommand;
    property Items[Index: Integer]: TSvrCommand read GetItem write SetItem;
  published
    property Display: TJDCmdDisplay read fDisplay write SetDisplay;
    property OnUnknownCommand: TJDScktSvrCmdEvent
      read fOnUnknownCommand write fOnUnknownCommand;
  end;

  TSvrCommand = class(TCollectionItem)
  private
    fID: Integer;
    fOnCommand: TJDScktSvrCmdEvent;
    fName: String;
    fParamCount: Integer;
    fCollection: TSvrCommands;
    fCaption: String;
    procedure SetID(Value: Integer);
    procedure SetName(Value: String);
    procedure SetCaption(const Value: String);
  protected
    function GetDisplayName: String; override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property ID: Integer read fID write SetID;
    property Name: String read fName write SetName;
    property Caption: String read fCaption write SetCaption;
    property ParamCount: Integer read fParamCount write fParamCount;
    property OnCommand: TJDScktSvrCmdEvent read fOnCommand write fOnCommand;
  end;

////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////

{ TSvrCommands }

function TSvrCommands.Add: TSvrCommand;
begin
  Result:= inherited Add as TSvrCommand;
end;

constructor TSvrCommands.Create(AOwner: TPersistent);
begin
  inherited Create(TSvrCommand);
  Self.fOwner:= AOwner;
end;

destructor TSvrCommands.Destroy;
begin
  inherited Destroy;
end;

procedure TSvrCommands.DoCommand(const Socket: TJDServerClientSocket;
  const Cmd: Integer; const Data: TStrings);
var
  X: Integer;
  C: TSvrCommand;
  F: Bool;
begin
  F:= False;
  for X:= 0 to Self.Count - 1 do begin
    C:= GetItem(X);
    if C.ID = Cmd then begin
      F:= True;
      try
        if assigned(C.fOnCommand) then
          C.fOnCommand(Self, Socket, Data);
      except
        on e: exception do begin
          raise Exception.Create(
            'Failed to execute command '+IntToStr(Cmd)+': '+#10+e.Message);
        end;
      end;
      Break;
    end;
  end;
  if not F then begin
    //Command not found

  end;
end;

function TSvrCommands.GetItem(Index: Integer): TSvrCommand;
begin
  Result:= TSvrCommand(inherited GetItem(Index));
end;

function TSvrCommands.GetOwner: TPersistent;
begin
  Result:= fOwner;
end;

procedure TSvrCommands.SetDisplay(const Value: TJDCmdDisplay);
begin
  fDisplay := Value;
end;

procedure TSvrCommands.SetItem(Index: Integer; Value: TSvrCommand);
begin
  inherited SetItem(Index, Value);
end;

{ TSvrCommand }

procedure TSvrCommand.Assign(Source: TPersistent);
begin
  inherited;

end;

constructor TSvrCommand.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  fCollection:= TSvrCommands(Collection);
end;

destructor TSvrCommand.Destroy;
begin
  inherited Destroy;
end;

function TSvrCommand.GetDisplayName: String;
begin        
  case Self.fCollection.fDisplay of
    cdName: begin
      Result:= fName;
    end;
    cdID: begin
      Result:= '['+IntToStr(fID)+']';
    end;
    cdCaption: begin
      Result:= fCaption;
    end;
    cdIDName: begin
      Result:= '['+IntToStr(fID)+'] '+fName;
    end;
    cdIDCaption: begin
      Result:= '['+IntToStr(fID)+'] '+fCaption;
    end;
  end;
end;

procedure TSvrCommand.SetCaption(const Value: String);
begin
  fCaption := Value;
end;

procedure TSvrCommand.SetID(Value: Integer);
begin
  fID:= Value;
end;

procedure TSvrCommand.SetName(Value: String);
begin
  fName:= Value;
end;

Answer 1

This Thread正如我们昨天讨论的那样，帮助我创造了一些东西。我拿了那里发布的包并对其进行了一些修改。来源如下:

TestComponents.pas

unit TestComponents;

interface

uses
  Classes;

type
  TParentComponent = class;

  TChildComponent = class(TComponent)
  private
    FParent: TParentComponent;
    procedure SetParent(const Value: TParentComponent);
  protected
    procedure SetParentComponent(AParent: TComponent); override;
  public
    destructor Destroy; override;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    property Parent: TParentComponent read FParent write SetParent;
  end;

  TParentComponent = class(TComponent)
  private
    FChilds: TList;
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Childs: TList read FChilds;
  end;

implementation

{ TChildComponent }

destructor TChildComponent.Destroy;
begin
  Parent := nil;
  inherited;
end;

function TChildComponent.GetParentComponent: TComponent;
begin
  Result := FParent;
end;

function TChildComponent.HasParent: Boolean;
begin
  Result := Assigned(FParent);
end;

procedure TChildComponent.SetParent(const Value: TParentComponent);
begin
  if FParent <> Value then
  begin
    if Assigned(FParent) then
      FParent.FChilds.Remove(Self);
    FParent := Value;
    if Assigned(FParent) then
      FParent.FChilds.Add(Self);
  end;
end;

procedure TChildComponent.SetParentComponent(AParent: TComponent);
begin
  if AParent is TParentComponent then
    SetParent(AParent as TParentComponent);
end;

{ TParentComponent }

constructor TParentComponent.Create(AOwner: TComponent);
begin
  inherited;
  FChilds := TList.Create;
end;

destructor TParentComponent.Destroy;
var
  I: Integer;
begin
  for I := 0 to FChilds.Count - 1 do
    FChilds[0].Free;
  FChilds.Free;
  inherited;
end;

procedure TParentComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  i: Integer;
begin
  for i := 0 to FChilds.Count - 1 do
    Proc(TComponent(FChilds[i]));
end;

end.

TestComponentsReg.pas

unit TestComponentsReg;

interface

uses
  Classes,
  DesignEditors,
  DesignIntf,
  TestComponents;

type
  TParentComponentEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

procedure Register;

implementation

uses
  ColnEdit;

type
  TChildComponentCollectionItem = class(TCollectionItem)
  private
    FChildComponent: TChildComponent;
    function GetName: string;
    procedure SetName(const Value: string);
  protected
    property ChildComponent: TChildComponent read FChildComponent write FChildComponent;
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Name: string read GetName write SetName;
  end;

  TChildComponentCollection = class(TOwnedCollection)
  private
    FDesigner: IDesigner;
  public
    property Designer: IDesigner read FDesigner write FDesigner;
  end;

procedure Register;
begin
  RegisterClass(TChildComponent);
  RegisterNoIcon([TChildComponent]);
  RegisterComponents('Test', [TParentComponent]);
  RegisterComponentEditor(TParentComponent, TParentComponentEditor);
end;

{ TParentComponentEditor }

procedure TParentComponentEditor.ExecuteVerb(Index: Integer);
var
  LCollection: TChildComponentCollection;
  i: Integer;
begin
  LCollection := TChildComponentCollection.Create(Component, TChildComponentCollectionItem);
  LCollection.Designer := Designer;
  for i := 0 to TParentComponent(Component).Childs.Count - 1 do
    with TChildComponentCollectionItem.Create(nil) do
    begin
      ChildComponent := TChildComponent(TParentComponent(Component).Childs[i]);
      Collection := LCollection;
    end;
  ShowCollectionEditorClass(Designer, TCollectionEditor, Component, LCollection, 'Childs');
end;

function TParentComponentEditor.GetVerb(Index: Integer): string;
begin
  Result := 'Edit Childs...';
end;

function TParentComponentEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TChildComponentCollectionItem }

constructor TChildComponentCollectionItem.Create(Collection: TCollection);
begin
  inherited;
  if Assigned(Collection) then
  begin
    FChildComponent := TChildComponent.Create(TComponent(TOwnedCollection(Collection).Owner).Owner);
    FChildComponent.Name := TChildComponentCollection(Collection).Designer.UniqueName(TChildComponent.ClassName);
    FChildComponent.Parent := TParentComponent(TComponent(TOwnedCollection(Collection).Owner));
  end;
end;

destructor TChildComponentCollectionItem.Destroy;
begin
  FChildComponent.Free;
  inherited;
end;

function TChildComponentCollectionItem.GetDisplayName: string;
begin
  Result := FChildComponent.Name;
end;

function TChildComponentCollectionItem.GetName: string;
begin
  Result := FChildComponent.Name;
end;

procedure TChildComponentCollectionItem.SetName(const Value: string);
begin
  FChildComponent.Name := Value;
end;

end.

最重要的是 RegisterNoIcon，它可以防止在创建组件时在表单上显示该组件。 TChildComponent 中的重写方法导致它们嵌套在 TParentComponent 内。

编辑:我添加了一个临时集合来编辑内置 TCollectionEditor 中的项目，而不必编写自己的集合。唯一的缺点是 TChildComponentCollectionItem 必须发布 TChildComponent 已发布的每个属性，以便能够在 OI 内编辑它们。