Создание компонента с именованными подкомпонентами?

Question

Мне нужно знать основы создания компонента и управления его компонентами. Я изначально попробовал это, создав TCollectionи попытался поставить имя на каждом TCollectionItem, Но я понял, что это не так просто, как я надеялся.

Так что теперь я собираюсь начать этот проект с нуля, и я хотел бы сделать это правильно на этот раз. Эти подкомпоненты не являются визуальными компонентами и не должны иметь никакого дисплея или окна, только на основе TComponent, Основной компонент, содержащий эти подкомпоненты, также будет основан на TComponent, Так что здесь вообще нет ничего визуального, и я не хочу, чтобы в моей форме (во время разработки) был маленький значок для каждого из этих подкомпонентов.

Я хотел бы иметь возможность поддерживать и управлять этими подкомпонентами в стиле коллекции. Важно то, что эти подкомпоненты должны быть созданы, названы и добавлены в источник формы, как, например, пункты меню. В этом весь смысл идеи, во-первых, если они не могут быть названы, тогда вся эта идея - капут.

О, еще одна важная вещь: главный компонент, являющийся родителем всех подкомпонентов, должен иметь возможность сохранять эти подкомпоненты в файл DFM.

ПРИМЕР:

Вместо доступа к одному из этих подпунктов, таких как:

MyForm.MyItems[1].DoSomething();

Я бы вместо этого хотел сделать что-то вроде:

MyForm.MyItem2.DoSomething();

Поэтому мне не нужно полагаться на знание идентификатора каждого подпункта.

РЕДАКТИРОВАТЬ:

Мне показалось немного необходимым включить мой оригинальный код, чтобы было видно, как работает оригинальная коллекция. Вот только сбор со стороны сервера и элемент сбора из полного блока:

//  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

Эта тема помогла мне создать что-то, как мы обсуждали вчера. Я взял посылку, размещенную там, и немного ее изменил. Вот источник:

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.

Answer 2

Использовать TComponent.SetSubComponent Режим дня:

type
  TComponent1 = class(TComponent)
  private
    FSubComponent: TComponent;
    procedure SetSubComponent(Value: TComponent);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property SubComponent: TComponent read FSubComponent write SetSubComponent;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TComponent1]);
end;

{ TComponent1 }

constructor TComponent1.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSubComponent := TComponent.Create(Self);  // Nót AOwner as owner here !!
  FSubComponent.Name := 'MyName';
  FSubComponent.SetSubComponent(True);
end;

procedure TComponent1.SetSubComponent(Value: TComponent);
begin
  FSubComponent.Assign(Value);
end;

Теперь я понимаю, что этот подкомпонент будет частью элемента коллекции. В этом случае: нет разницы, используйте этот метод.

Answer 3

Воплощать в жизнь TCollectionItem.GetDisplayName "назвать" предметы коллекции.

А что касается коллекции: если это опубликованное свойство, коллекция автоматически будет названа именем свойства.

Будьте осторожны в реализацииGetOwner когда вы создаете свойства TPersistent,