Based on this GenericTree I have implemented the following generic tree node structure:
type
TTreeNode<T>=class
private
procedure FreeChildNodes;
procedure RemoveMyselfFromParentChildNodesList;
function GetIndexInParentChildNodesList: Integer;
public
NodeData: T;
ChildNodes: TList<TTreeNode<T>>;
ParentNode: TTreeNode<T>;
constructor Create(const AParentNode: TTreeNode<T>); overload;
destructor Destroy; override;
end;
implementation
constructor TTreeNode<T>.Create(const AParentNode: TTreeNode<T>);
begin
inherited Create;
ParentNode:=AParentNode;
ChildNodes:=TList<TTreeNode<T>>.Create;
end;
destructor TTreeNode<T>.Destroy;
begin
FreeChildNodes;
RemoveMyselfFromParentChildNodesList;
ChildNodes.Free;
inherited;
end;
procedure TTreeNode<T>.FreeChildNodes;
var
i: Integer;
begin
for i := ChildNodes.Count-1 downto 0 do
begin
ChildNodes[i].Free;
end;
ChildNodes.Clear;
end;
function TTreeNode<T>.GetIndexInParentChildNodesList: Integer;
var
i: Integer;
begin
Result:=-1;
if ParentNode<>nil then
begin
Result:=ParentNode.ChildNodes.IndexOf(Self);
end;
end;
procedure TTreeNode<T>.RemoveMyselfFromParentChildNodesList;
begin
if ParentNode<>nil then
begin
ParentNode.ChildNodes.Delete(GetIndexInParentChildNodesList);
end;
end;
This is working fine.
Now I would like to create an descendant class with a specific object type.
The object type is:
type
TMyObject=class
public
Value: string;
constructor Create; override;
destructor Destroy; override;
end;
And the new descendant class:
type
TMyTreeNode=class(TTreeNode<TMyObject>)
private
public
constructor Create(const AParentNode: TMyTreeNode); overload;
destructor Destroy; override;
end;
implementation
constructor TMyTreeNode.Create(const AParentNode: TMyTreeNode);
begin
inherited Create(AParentNode);
NodeData:=TMyObject.Create;
end;
destructor TMyTreeNode.Destroy;
begin
NodeData.Free;
inherited;
end;
When I free a TMyTreeNode with TMyTreeNode.Destroy the inherited TTreeNode<T>.Destroy is called to free the ChildNodes recursively. The problem is that all ChildNodes are then freed with TTreeNode<T>.Destroy and therefore the TMyObjects are not freed leaving a memory leak.
I also tried to use TObjectList instead of TList for the ChildNodes. However the TObjectList seems to destroy itself before I can free the child nodes.
How to solve this problem?
You could use:
procedure TTreeNode<T>.FreeChildNodes;
var
i: Integer;
begin
for i := ChildNodes.Count-1 downto 0 do
begin
ChildNodes[i].NodeData.free;
ChildNodes[i].Free;
end;
ChildNodes.Clear;
end;
There's no need to override the destructor if it only affects fields of the parent type. In your case the TMyTreeNode.Destroy only frees the NodeData from the parent, so you might just as well do it in the TTreeNode<T>.FreeChildNodes procedure.
Related
I have my own component (TNiftyRVFrameWithPopups) with a TOwnedCollection as a property (TagList).
Every time I add items to TagList the same item should be added to another object (FMenu). This is performed by the procedure RefreshMenu called from TNiftyRVFrameWithPopups.Loaded on design time.
My issue is I cannot add items on runtime, because TNiftyRVFrameWithPopups.Loaded is not called.
I thought one solution would be Postmessage but I didn't manage to make it work.
The following is the source:
TNiftyListTag = class(TCollectionItem)
private
FTagValue: string;
FDisplayTextTag: string;
public
procedure Assign(Source: TPersistent); override;
published
property DisplayTag: string read FDisplayTextTag write FDisplayTextTag;
property Value: string read FTagValue write FTagValue;
end;
TNiftyListTags = class(TOwnedCollection)
protected
function GetItem(Index: Integer): TNiftyListTag;
procedure SetItem(Index: Integer; Value: TNiftyListTag);
public
constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
function Add: TNiftyListTag;
end;
TNiftyRVFrameWithPopups = class(TRVEditFrame)
private
FMenu: TAdvSmoothListBox;
FMenuList: TStringList;
FCollectionTags: TNiftyListTags;
procedure SetCollectionTags(const Value: TNiftyListTags);
procedure RefreshMenu;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Loaded; override;
published
property TagList: TNiftyListTags read FCollectionTags write SetCollectionTags;
end;
implementation
constructor TNiftyRVFrameWithPopups.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMenuList := TStringList.Create;
FCollectionTags := TNiftyListTags.Create(Self, TNiftyListTag);
end;
procedure TNiftyRVFrameWithPopups.SetCollectionTags(const Value: TNiftyListTags);
begin
FCollectionTags.Assign(Value);
end;
procedure TNiftyRVFrameWithPopups.RefreshMenu;
var
i: Integer;
begin
FMenu.Items.Clear;
for i := 0 to FCollectionTags.Count - 1 do
begin
FMenu.Items.Add;
FMenu.Items.Items[i].Caption := FCollectionTags.Items[i].FDisplayTextTag;
end;
end;
procedure TNiftyRVFrameWithPopups.Loaded;
begin
inherited Loaded;
if Assigned(FRVEditor) then
begin
RefreshMenu;
end;
end;
{ TNiftyListTag }
procedure TNiftyListTag.Assign(Source: TPersistent);
begin
if Source is TNiftyListTag then
begin
FTagValue := TNiftyListTag(Source).FTagValue;
FDisplayTextTag := TNiftyListTag(Source).FDisplayTextTag;
end
else
inherited;
end;
{ TNiftyListTags }
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
end;
constructor TNiftyListTags.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
begin
inherited Create(AOwner, ItemClass);
end;
procedure TNiftyListTags.SetItem(Index: Integer; Value: TNiftyListTag);
begin
inherited SetItem(index, Value);
end;
function TNiftyListTags.GetItem(Index: Integer): TNiftyListTag;
begin
Result := TNiftyListTag(inherited GetItem(Index));
end;
EDIT
After Deltics' advice I have amended my code:
TNiftyListTag = class(TCollectionItem)
private
FTagValue: string;
FDisplayTextTag: string;
public
procedure Assign(Source: TPersistent); override;
published
property DisplayTag: string read FDisplayTextTag write FDisplayTextTag;
property Value: string read FTagValue write FTagValue;
end;
TNiftyListTags = class(TOwnedCollection)
private
fOnChanged: TNotifyEvent;
procedure DoOnChanged;
protected
function GetItem(Index: Integer): TNiftyListTag;
procedure SetItem(Index: Integer; Value: TNiftyListTag);
public
constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
function Add: TNiftyListTag;
procedure AppendItem(const aDisplayText, aTag: string);
end;
TNiftyRVFrameWithPopups = class(TRVEditFrame)
private
FMenu: TAdvSmoothListBox;
FMenuList: TStringList;
FCollectionTags: TNiftyListTags;
procedure RefreshMenu;
procedure SetCollectionTags(const Value: TNiftyListTags);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
published
property TagList: TNiftyListTags read FCollectionTags write SetCollectionTags;
end;
implementation
constructor TNiftyRVFrameWithPopups.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMenuList := TStringList.Create;
FCollectionTags := TNiftyListTags.Create(Self, TNiftyListTag);
FCollectionTags.fOnChanged := RefreshMenu;
end;
destructor TNiftyRVFrameWithPopups.Destroy;
begin
FreeAndNil(FMenuList);
FCollectionTags.Free;
inherited;
end;
procedure TNiftyRVFrameWithPopups.RefreshMenu;
var
i: Integer;
begin
FMenu.Items.Clear;
for i := 0 to FCollectionTags.Count - 1 do
begin
FMenu.Items.Add;
FMenu.Items.Items[i].Caption := FCollectionTags.Items[i].FDisplayTextTag;
end;
end;
procedure TNiftyRVFrameWithPopups.Loaded;
begin
inherited Loaded;
RefreshMenu(Self);
end;
procedure TNiftyRVFrameWithPopups.RefreshMenu;
var
i: Integer;
begin
if Assigned(FRVEditor) then
begin
(FRVEditor as TCustomRichViewEdit).OnRVMouseUp := OnMouseUp;
FMenu.Parent := FRVEditor;
fmenu.Items.Clear;
for i := 0 to FCollectionTags.Count - 1 do
begin
FMenu.Items.Add;
FMenu.Items.Items[i].Caption := FCollectionTags.Items[i].FDisplayTextTag;
end;
end;
end;
procedure TNiftyRVFrameWithPopups.SetCollectionTags(const Value: TNiftyListTags);
begin
FCollectionTags.Assign(Value);
end;
{ TNiftyListTag }
procedure TNiftyListTag.Assign(Source: TPersistent);
begin
if Source is TNiftyListTag then
begin
FTagValue := TNiftyListTag(Source).FTagValue;
FDisplayTextTag := TNiftyListTag(Source).FDisplayTextTag;
end
else
inherited;
end;
{ TNiftyListTags }
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
end;
procedure TNiftyListTags.AppendItem(const aDisplayText, aTag: string);
var
a: TNiftyListTag;
begin
a := TNiftyListTag(inherited Add);
a.FTagValue := aTag;
a.FDisplayTextTag := aDisplayText;
DoOnChanged;
end;
constructor TNiftyListTags.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
begin
inherited Create(AOwner, ItemClass);
end;
procedure TNiftyListTags.DoOnChanged;
begin
if Assigned(fOnChanged) then
fOnChanged(self);
end;
procedure TNiftyListTags.SetItem(Index: Integer; Value: TNiftyListTag);
begin
inherited SetItem(index, Value);
end;
function TNiftyListTags.GetItem(Index: Integer): TNiftyListTag;
begin
Result := TNiftyListTag(inherited GetItem(Index));
end;
procedure TNiftyListTags.SetItem(Index: Integer; Value: TNiftyListTag);
begin
inherited SetItem(index, Value);
DoOnChanged;
end;
end.
Items can be added at run time in the following way:
var
a:TNiftyRVFrameWithPopups;
begin
a:=TNiftyRVFrameWithPopups.Create(self);
.....
a.TagList.AppendItem('a','b');
a.TagList.AppendItem('c','d');
end
Your TNiftyListTags is owned by the TNiftyRVFrameWithPopups.
Your only 'problem' is that the TOwnedCollection class does not provide a typed reference to the owner, by which to invoke the necessary method(s) to refresh the owner when the collection changes.
There are a number of ways to achieve what you want. However, before presenting options, whatever you do I suggest you do not call Loaded to achieve your update/refresh since this method has specific meaning. Whilst your code in the overridden method may be safe in this context, the inherited implementation may not be.
I would suggest moving the if Assigned(fRVEditor) pre-condition check to RefreshMenu itself. Loaded then simply calls RefreshMenu as may any other code that may need to also call RefreshMenu, with the necessary pre-condition checked by the method itself.
Now, as for how and when to call the RefreshMenu method, one simple mechanism is to directly invoke the refresh method whenever the content of the collection changes. e.g. in the Add method of the collection. Since you are using a TOwnedCollection as the base class, you could simply type-cast the Owner:
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
TNiftyRVFrameWithPopups(Owner).RefreshMenu;
end;
However, this couples your collection class directly to the specific component acting as the owner. If your collection is specialised to this class specifically then this may be valid, but it is still undesirable.
To de-couple the collection from the component you could alternatively introduce an OnChange event on the collection. A simple TNotifyEvent will usually suffice.
Whichever component then owns the collection may then install a handler for this event. Whenever the collection changes, invoke the OnChange handler. In this case the TNiftyRVFrameWithPopups component will respond to those changes by calling its own RefreshMenu method.
procedure TNiftyListTags.DoOnChanged;
begin
if Assigned(fOnChanged) then
fOnChanged(self);
end;
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
DoOnChanged;
end;
procedure TNiftyRVFrameWithPopups.OnTagsChanged(Sender: TObject);
begin
RefreshMenu;
end;
This is typically the approach I adopt and I make the OnChange event a private implementation detail, with the handler specified in the constructor by the component instantiating the collection. This prevents anyone from inadvertently replacing the event handler via any public property etc.
constructor TNiftyRVFrameWithPopups.Create(Owner: TComponent);
begin
inherited Create(self);
fTags := TNiftyListTags.Create(self, OnTagsChanged);
..
end;
To facilitate this you obviously need a custom constructor to accept the event handler:
TNiftyListTags = class(TOwnedCollection)
..
private
fOnChanged: TNotifyEvent;
public
constructor Create(aOwner: TPersistent; aOnChange: TNotifyEvent); reintroduce;
..
end;
constructor TNiftyListTags.Create(aOwner: TPersistent;
aOnChange: TNotifyEvent);
begin
inherited Create(aOwner, TNiftyListTag);
fOnChange := aOnChange;
end;
Note that the inherited constructor also accepts two parameters, the second being the class of the collection items. Sine you are introducing a custom constructor you can remove this from the parameters of your own constructor and simply specify the item class in the inherited Create call.
NOTE: This does not increase the coupling between the collection and the item class - they are already tightly coupled, by definition (and design).
I want to write a program that works on a hierarchically organized tree data structure.
I need to have a root node and then be able to add child nodes and to move these node across the complete tree.
Is there a data structure in Delphi I can use for my algorithms and then later simply "copy" it to the GUI using a TTreeview component?
I suppose I need such a class:
type
TMyElement = class(...)
ElementName: String;
...
ChildElementList: TMyElementList;
HasChildElement: Boolean;
...
end;
At the dots, there will be more fields and routines specific for the element. How to build up this class? And how can I conveniently add these elements to a TreeView, using the ElementName field as caption for the tree nodes?
So, you have two questions:
How to build up this class?
Well, not yet focusing on the viewing-in-a-tree-view-ability, you could descent your class from TObjectList. Doing so, every element is capable of holding more of these object lists = elements. This approach is for example used for TMenuItem too.
And how can I conveniently add these elements to a TreeView, using the ElementName field as caption for the tree nodes?
You could add an AssignTo method to the class so that you can "assign" the root node to the TreeView.
Here you have an example implementation of the whole class. Add own properties as needed.
type
TElement = class(TObjectList)
private
FName: String;
FParent: TElement;
function GetItem(Index: Integer): TElement;
function GetLevel: Integer;
procedure SetItem(Index: Integer; Value: TElement);
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
function Add(AElement: TElement): Integer;
procedure AssignTo(Dest: TPersistent);
constructor Create; overload;
constructor Create(AName: String); overload;
constructor Create(AParent: TElement); overload;
constructor Create(AParent: TElement; AName: String); overload;
destructor Destroy; override;
function HasChilds: Boolean;
procedure Insert(Index: Integer; AElement: TObject);
property Items[Index: Integer]: TElement read GetItem write SetItem;
default;
property Level: Integer read GetLevel;
property Name: String read FName write FName;
end;
{ TElement }
function TElement.Add(AElement: TElement): Integer;
begin
if AElement = nil then
Result := -1
else
Result := inherited Add(AElement);
end;
procedure TElement.AssignTo(Dest: TPersistent);
var
Nodes: TTreeNodes;
Node: TTreeNode;
I: Integer;
begin
if Dest is TTreeView then
AssignTo(TTreeView(Dest).Items)
else if Dest is TTreeNodes then
begin
Nodes := TTreeNodes(Dest);
Nodes.BeginUpdate;
Nodes.Clear;
for I := 0 to Count - 1 do
begin
Node := Nodes.AddNode(nil, nil, Items[I].Name, Items[I], naAdd);
Items[I].AssignTo(Node);
end;
Nodes.EndUpdate;
end
else if Dest is TTreeNode then
begin
Node := TTreeNode(Dest);
Nodes := Node.Owner;
for I := 0 to Count - 1 do
Items[I].AssignTo(
Nodes.AddNode(nil, Node, Items[I].Name, Items[I], naAddChild));
end;
end;
constructor TElement.Create;
begin
Create(nil, '');
end;
constructor TElement.Create(AName: String);
begin
Create(nil, AName);
end;
constructor TElement.Create(AParent: TElement);
begin
Create(AParent, '');
end;
constructor TElement.Create(AParent: TElement; AName: String);
begin
inherited Create(True);
FName := AName;
if AParent <> nil then
AParent.Add(Self);
end;
destructor TElement.Destroy;
begin
if FParent <> nil then
FParent.Extract(Self);
inherited Destroy;
end;
function TElement.GetItem(Index: Integer): TElement;
begin
Result := TElement(inherited Items[Index]);
end;
function TElement.GetLevel: Integer;
begin
if FParent = nil then
Result := 0
else
Result := FParent.Level + 1;
end;
function TElement.HasChilds: Boolean;
begin
Result := Count > 0;
end;
procedure TElement.Insert(Index: Integer; AElement: TObject);
begin
if AElement <> nil then
inherited Insert(Index, AElement);
end;
procedure TElement.Notify(Ptr: Pointer; Action: TListNotification);
begin
inherited Notify(Ptr, Action);
case Action of
lnAdded:
TElement(Ptr).FParent := Self;
lnExtracted,
lnDeleted:
TElement(Ptr).FParent := nil;
end;
end;
procedure TElement.SetItem(Index: Integer; Value: TElement);
begin
inherited Items[Index] := Value;
end;
Example usage:
procedure TForm2.FormCreate(Sender: TObject);
begin
FRoot := TElement.Create;
TElement.Create(FRoot, '1');
TElement.Create(FRoot, '2');
TElement.Create(FRoot[1], '2.1');
TElement.Create(FRoot[1], '2.2');
TElement.Create(FRoot[1][0], '2.1.1');
TElement.Create(FRoot[1][0][0], '2.1.1.1');
TElement.Create(FRoot[1][0][0], '2.1.1.2');
TElement.Create(FRoot[1], '2.3');
TElement.Create(FRoot, '3');
TElement.Create(FRoot, '4');
TElement.Create(FRoot[3], '4.1');
FRoot.AssignTo(TreeView1);
end;
Filling a TTreeView at runtime is great fun!
Google 'rmtreenonview'. It is a single unit which implements a non-visual TTreeView-like class--most of the methods and properties are fully compatible with TTreeView.
rmtreenonview is quick and lightweight...we use it for manipulating a bunch of tree-structured data, but write the results to a grid control for display. But, you could copy results to a TTReeView just as easily.
Oh, and it also has hash-based tree searching capability and a couple other additons.
The following code (when registered in a package) gives us a component called TParentComponent registered in the pallet Test.
However, when you create a Child object using the Property Editor (provided in the same code), the IDE displays the error message Cannot create a method for an unnamed component.
What's strange is that the Child object does indeed have a name.
Here's the source:
unit TestEditorUnit;
interface
uses
Classes, DesignEditors, DesignIntf;
type
TParentComponent = class;
TChildComponent = class(TComponent)
private
FParent: TParentComponent;
FOnTest: TNotifyEvent;
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;
published
property OnTest: TNotifyEvent read FOnTest write FOnTest;
end;
TParentComponent = class(TComponent)
private
FChilds: TList;
protected
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Childs: TList read FChilds;
end;
TParentPropertyEditor = class(TPropertyEditor)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure Edit; override;
end;
procedure Register;
implementation
uses
ColnEdit;
type
TChildComponentCollectionItem = class(TCollectionItem)
private
FChildComponent: TChildComponent;
function GetName: string;
function GetOnTest: TNotifyEvent;
procedure SetName(const Value: string);
procedure SetOnTest(const Value: TNotifyEvent);
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;
property OnTest: TNotifyEvent read GetOnTest write SetOnTest;
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]);
RegisterPropertyEditor(TypeInfo(TList), TParentComponent, 'Childs', TParentPropertyEditor);
end;
{ 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
TComponent(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;
{ 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;
function TChildComponentCollectionItem.GetOnTest: TNotifyEvent;
begin
Result := FChildComponent.OnTest;
end;
procedure TChildComponentCollectionItem.SetName(const Value: string);
begin
FChildComponent.Name := Value;
end;
procedure TChildComponentCollectionItem.SetOnTest(const Value: TNotifyEvent);
begin
FChildComponent.OnTest := Value;
end;
{ TParentPropertyEditor }
procedure TParentPropertyEditor.Edit;
var
LCollection: TChildComponentCollection;
i: Integer;
begin
LCollection := TChildComponentCollection.Create(GetComponent(0), TChildComponentCollectionItem);
LCollection.Designer := Designer;
for i := 0 to TParentComponent(GetComponent(0)).Childs.Count - 1 do
with TChildComponentCollectionItem.Create(nil) do
begin
ChildComponent := TChildComponent(TParentComponent(GetComponent(0)).Childs[i]);
Collection := LCollection;
end;
ShowCollectionEditorClass(Designer, TCollectionEditor, TComponent(GetComponent(0)), LCollection, 'Childs');
end;
function TParentPropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog];
end;
function TParentPropertyEditor.GetValue: string;
begin
Result := 'Childs';
end;
end.
The above source was adapated from another answer here on StackOverflow.
Any ideas why I cannot create a method for OnTest?
Thanks in advance!
Design time requirement summary
You want or need a custom component that is capable of holding multiple child components.
Those child components are to be created by that custom component.
The child components need to be able to be referenced in code by their name as any normal component that is placed design time; thus not Form.CustomComponent.Children[0], but Form.Child1 instead.
Therefore, the child components need to be declared in - and thus added to - the source file of the module (a Form, Frame or DataModule).
The child components are to be managed by the default IDE collection editor.
Therefore, a child needs to completely be wrapped into a TCollectionItem.
Evaluation of current code
You are going quite well already, but besides your question, the code has a few points for improvement:
The collections you create are never freed.
A new collection is created every time you show the collection editor.
If you delete a child from the TreeView, then the old corresponding CollectionItem stays, resulting in an AV.
The design time and run time code is not split.
Solution
Here is a rewritten, working version of your code, with the following changes:
The special component is called Master, because Parent confuses too much with Delphi's Parent (there are two kind already). Therefore a child is called Slave.
Slaves are held in a TComponentList (unit Contnrs) to automatically update the list in case of individual slave destruction. The ComponentList owns the slaves.
For every single Master, only one Collection is created. These Master-Collection-combinations are held in a separate TStockItems ObjectList. The List owns the stock items, and the list is freed in the Finalization section.
GetNamePath is implemented so that a slave is shown as Slave1 in the Object Inspector, instead of as SlaveWrappers(0).
An extra property editor is added for the event of the TSlaveWrapper class. Somehow GetFormMethodName of the default TMethodProperty results in the error you are getting. The cause will ly in Designer.GetObjectName, but I do not know exactly why. Now GetFormMethodName is overriden, which solves the problem from your question.
Remarks
Changes made in the order of the items in the collection (with the arrow buttons of the collection editor) are not preserved yet. Try yourself to get that implemented.
In the TreeView, each Slave is now an immediate child of the Master, instead of being child of the Slaves property, as normally seen with collections:
For this to happen, I think TSlaves should descend from TPersistent, and the ComponentList would be wrapped inside it. That sure is another nice tryout.
Component code
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.
Editor code
unit MasterSlaveEdit;
interface
uses
Classes, SysUtils, MasterSlave, Contnrs, DesignEditors, 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, Master,
Stock.CollectionOf(Master, 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.
Registration code
unit MasterSlaveReg;
interface
uses
Classes, MasterSlave, 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.
Package code
requires
rtl,
DesignIDE;
contains
MasterSlave in 'MasterSlave.pas',
MasterSlaveEdit in 'MasterSlaveEdit.pas',
MasterSlaveReg in 'MasterSlaveReg.pas';
A sufficient "workaround" was found on About.com's "Creating Custom Delphi Components, Part 2, Page 4 of 5" article.
Full sample source is on their article, and works (seemingly) with all versions of Delphi.
However, it should be noted that this solution isn't perfect as it doesn't allow you to separate the Collection Editor from the Parent and Child components (meaning you have to produce the source for both components to enable the Collection Editor to work, and place that in your runtime package).
For my needs right now, this will do... but if anyone can find a better solution based directly on the example code posted in my question, that'd be great (and I'll mark that answer as Correct should anyone provide it).
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.
Use the TComponent.SetSubComponent routine:
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;
I now understand this sub component would be part of a collection item. In that case: no difference, use this method.
Implement TCollectionItem.GetDisplayName to "name" the collection items.
And concerning the collection: when this is a published property, the collection will automatically be named as the property name.
Be careful to implement GetOwner when you create properties of TPersistent.
I've got my custom collection property which is working great when it is a direct member of my component.
But I want to move the collection property to a TPersistent propery within my component. And now comes the problem, it doesn't work: double clicking on the collection property in the object inspector normally opens the collection editor, but it does not anymore.
Fist of all - what should I pass to the contructor of the TPersistent property?
TMyCollection = class(TCollection)
constructor Create(AOwner: TComponent); // TMyCollection constuctor
...
I can't pass Self, so should I pass my persistent owner?
constructor TMyPersistent.Create(AOwner: TComponent);
begin
inherited Create;
fOwner := AOwner;
fMyCollection := TMyCollection.Create(AOwner); // hmmm... doesn't make sense
end;
I think I'm missing something. If more code is needed just please comment this post.
A TCollection's constructor does not need a TComponent, but a TCollectionItemClass.
Your collection now being a member of a TPersistent property instead of being a direct member of the component makes no difference for the constructor.
Update
What dóes differ is the ownership, but then at the TPersistent level, which should be managed by a correct implementation of GetOwner:
GetOwner returns the owner of an object. GetOwner is used by the GetNamePath method to find the owner of a persistent object. GetNamePath and GetOwner are introduced in TPersistent so descendants such as collections can appear in the Object Inspector.
You have to tell the IDE that your TCollection property is owned by the TPersistent property, which in turn is owned by the component.
The tutorial you are using has several errors regarding this implementation:
The owner of the collection is declared as TComponent, which should be TPersistent,
GetOwner is not implemented for the TPersistent property class, and
The fix shown at the end of the tutorial, stating that the TPersistent property should inherit from TComponent instead, is plain wrong; or more nicely said: is rather a workaround for not implementing GetOwner.
This is how it should look like:
unit MyComponent;
interface
uses
Classes, SysUtils;
type
TMyCollectionItem = class(TCollectionItem)
private
FStringProp: String;
protected
function GetDisplayName: String; override;
public
procedure Assign(Source: TPersistent); override;
published
property StringProp: String read FStringProp write FStringProp;
end;
TMyCollection = class(TCollection)
private
FOwner: TPersistent;
function GetItem(Index: Integer): TMyCollectionItem;
procedure SetItem(Index: Integer; Value: TMyCollectionItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TPersistent);
function Add: TMyCollectionItem;
function Insert(Index: Integer): TMyCollectionItem;
property Items[Index: Integer]: TMyCollectionItem read GetItem
write SetItem;
end;
TMyPersistent = class(TPersistent)
private
FOwner: TPersistent;
FCollectionProp: TMyCollection;
procedure SetCollectionProp(Value: TMyCollection);
protected
function GetOwner: TPersistent; override;
public
procedure Assign(Source: TPersistent); override;
constructor Create(AOwner: TPersistent);
destructor Destroy; override;
published
property CollectionProp: TMyCollection read FCollectionProp
write SetCollectionProp;
end;
TMyComponent = class(TComponent)
private
FPersistentProp: TMyPersistent;
procedure SetPersistentProp(Value: TMyPersistent);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property PersistentProp: TMyPersistent read FPersistentProp
write SetPersistentProp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyComponent]);
end;
{ TMyCollectionItem }
procedure TMyCollectionItem.Assign(Source: TPersistent);
begin
if Source is TMyCollectionItem then
FStringProp := TMyCollectionItem(Source).FStringProp
else
inherited Assign(Source);
end;
function TMyCollectionItem.GetDisplayName: String;
begin
Result := Format('Item %d',[Index]);
end;
{ TMyCollection }
function TMyCollection.Add: TMyCollectionItem;
begin
Result := TMyCollectionItem(inherited Add);
end;
constructor TMyCollection.Create(AOwner: TPersistent);
begin
inherited Create(TMyCollectionItem);
FOwner := AOwner;
end;
function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
Result := TMyCollectionItem(inherited GetItem(Index));
end;
function TMyCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
function TMyCollection.Insert(Index: Integer): TMyCollectionItem;
begin
Result := TMyCollectionItem(inherited Insert(Index));
end;
procedure TMyCollection.SetItem(Index: Integer; Value: TMyCollectionItem);
begin
inherited SetItem(Index, Value);
end;
{ TMyPersistent }
procedure TMyPersistent.Assign(Source: TPersistent);
begin
if Source is TMyPersistent then
CollectionProp := TMyPersistent(Source).FCollectionProp
else
inherited Assign(Source);
end;
constructor TMyPersistent.Create(AOwner: TPersistent);
begin
inherited Create;
FOwner := AOwner;
FCollectionProp := TMyCollection.Create(Self);
end;
destructor TMyPersistent.Destroy;
begin
FCollectionProp.Free;
inherited Destroy;
end;
function TMyPersistent.GetOwner: TPersistent;
begin
Result := FOwner;
end;
procedure TMyPersistent.SetCollectionProp(Value: TMyCollection);
begin
FCollectionProp.Assign(Value);
end;
{ TMyComponent }
constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPersistentProp := TMyPersistent.Create(Self);
end;
destructor TMyComponent.Destroy;
begin
FPersistentProp.Free;
inherited Destroy;
end;
procedure TMyComponent.SetPersistentProp(Value: TMyPersistent);
begin
FPersistentProp.Assign(Value);
end;
end.
But may I say that you can also inherit from TOwnedCollection, which makes the use and the declaration of TMyCollection much simpler:
TMyCollection = class(TOwnedCollection)
private
function GetItem(Index: Integer): TMyCollectionItem;
procedure SetItem(Index: Integer; Value: TMyCollectionItem);
public
function Add: TMyCollectionItem;
function Insert(Index: Integer): TMyCollectionItem;
property Items[Index: Integer]: TMyCollectionItem read GetItem
write SetItem;
end;