Creating a component with named subcomponents?

Question

I need to know the basics of creating a component and managing subcomponents. First I tried this by creating a TCollection and tried to put a name in every TCollectionItem . But I found out that it is not as simple as I had hoped.

So now I'm going to start this project from scratch again, and this time I want to do everything right. These subcomponents are not visual components and should not have any display or window, only based on TComponent . The main component containing these subcomponents will also be based on TComponent . So nothing here is visual at all, and I don’t want to have a small icon in my form (during development) for each of these subcomponents.

I would like to be able to maintain and manage these subcomponents as a collection. The important thing is that these subcomponents must be created, named and added to the form source, such as menu items. That is the whole point of the idea, first of all, if they cannot be called, then this whole idea is kaput.

Oh, one more important thing: the main component that is the parent of all subcomponents should be able to save these subcomponents in a DFM file.

Example:

Instead of accessing one of these sub-elements, for example:

 MyForm.MyItems[1].DoSomething(); 

Instead, I would like to do something like:

 MyForm.MyItem2.DoSomething(); 

Therefore, I do not need to rely on the identifier of each element.

EDIT:

I felt that I needed to include my original code a bit so that I could see how the original collection works. Here, only the server-side data collection and collection is removed from the full block:

 // 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 section helped me create something we talked about yesterday. I took the package posted there and modified it a bit. Here is the source:

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. 

The most important thing is RegisterNoIcon, which prevents the component from showing on the form when it is created. Overridden methods in TChildComponent cause their nesting inside TParentComponent.

Edit: I added a temporary collection to edit elements in the built-in TCollectionEditor instead of writing my own. The only drawback is that TChildComponentCollectionItem must publish every property that TChildComponent has published in order to edit them inside the OI.

Answer 2

Use 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; 

Now I understand that this additional component will be part of the collection item. In this case: it makes no difference, use this method.

Answer 3

TCollectionItem.GetDisplayName "name" of the collection items.

And in relation to the collection: when this is a published property, the collection will be automatically named as the name of the property.

Be careful with implementing GetOwner when creating TPersistent properties.