I need to know the basics behind making a component produce and manage sub-components. I originally tried this by creating a TCollection, and tried to put a name on each TCollectionItem. But I learned it's not that easy as I had hoped.
So now I am going to start this project from scratch again, and I'd like to get it right this time. These sub-components are not visual components, and should not have any display or window, just based off of TComponent. The main component holding these sub-components will also be based off of TComponent. So nothing here is visual at all, and I don't want a little icon on my form (in design time) for each of these sub-components.
I would like to be able to maintain and manage these sub-components in a collection-like fashion. The important thing is that these sub-components should be created, named and added to the form source, just like menu items are for example. This is the whole point of the idea in the first place, if they cannot be named, then this whole idea is kaput.
Oh, another important thing: the main component being the parent of all the sub-components needs to be able to save these sub-components to the DFM file.
EXAMPLE:
Instead of accessing one of these sub items like:
MyForm.MyItems[1].DoSomething();
I would instead like to do something like:
MyForm.MyItem2.DoSomething();
So I do not have to rely on knowing the ID of each sub item.
EDIT:
I felt it a little necessary to include my original code so it can be seen how the original collection works. Here's just the server side collection and collection item stripped from the full unit:
// 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;
This Thread helped me creating something as we discussed 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 the RegisterNoIcon which prevents showing the component on the form when you create it. The overridden methods in TChildComponent are causing them to be nested inside the TParentComponent.
Edit: I added a temporary collection to edit the items in the built-in TCollectionEditor instead of having to write an own one. The only disadvantage is that the TChildComponentCollectionItem has to publish every property that TChildComponent has published to be able to edit them inside the OI.