"Cannot create a method for an unnamed component" - delphi

Question

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!

Answer 1

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

Answer 2

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).