“无法创建未命名组件的方法” [英] "Cannot create a method for an unnamed component"
问题描述
以下代码(在程序包中注册时)向我们提供了一个名为 TParentComponent
的组件,在托盘中注册 Test
但是,当您使用属性编辑器(以相同的代码提供)创建一个Child对象时,IDE会显示错误消息无法创建一个方法一个未命名的组件。
奇怪的是,Child对象确实有一个名字。
来源:
unit TestEditorUnit;
接口
使用
类,DesignEditors,DesignIntf;
type
TParentComponent = class;
TChildComponent = class(TComponent)
private
FParent:TParentComponent;
FOnTest:TNotifyEvent;
procedure SetParent(const Value:TParentComponent);
protected
procedure SetParentComponent(AParent:TComponent);覆盖;
public
析构函数Destroy;覆盖;
函数GetParentComponent:TComponent;覆盖;
函数HasParent:Boolean;覆盖;
属性父:TParentComponent读FParent写SetParent;
发布
属性OnTest:TNotifyEvent读取FOnTest写入FOnTest;
结束
TParentComponent = class(TComponent)
private
FChilds:TList;
protected
procedure GetChildren(Proc:TGetChildProc; Root:TComponent);覆盖;
public
构造函数Create(AOwner:TComponent);覆盖;
析构函数覆盖;
发布
属性Childs:TList读取FChilds;
结束
TParentPropertyEditor = class(TPropertyEditor)
public
函数GetAttributes:TPropertyAttributes;覆盖;
函数GetValue:string;覆盖;
程序编辑;覆盖;
结束
程序注册;
实现
使用
ColnEdit;
type
TChildComponentCollectionItem = class(TCollectionItem)
private
FChildComponent:TChildComponent;
函数GetName:string;
函数GetOnTest:TNotifyEvent;
procedure SetName(const Value:string);
procedure SetOnTest(const Value:TNotifyEvent);
protected
属性ChildComponent:TChildComponent读取FChildComponent写入FChildComponent;
函数GetDisplayName:string;覆盖;
public
构造函数Create(Collection:TCollection);覆盖;
析构函数覆盖;
发布
属性名称:字符串读取GetName写SetName;
属性OnTest:TNotifyEvent读取GetOnTest写入SetOnTest;
结束
TChildComponentCollection = class(TOwnedCollection)
private
FDesigner:IDesigner;
public
属性设计师:IDesigner读FDesigner写FDesigner;
结束
程序注册;
begin
RegisterClass(TChildComponent);
RegisterNoIcon([TChildComponent]);
RegisterComponents('Test',[TParentComponent]);
RegisterPropertyEditor(TypeInfo(TList),TParentComponent,'Childs',TParentPropertyEditor);
结束
{TChildComponent}
析构函数TChildComponent.Destroy;
begin
父级:= nil;
继承;
结束
函数TChildComponent.GetParentComponent:TComponent;
begin
结果:= FParent;
结束
函数TChildComponent.HasParent:Boolean;
begin
结果:=已分配(FParent);
结束
procedure TChildComponent.SetParent(const Value:TParentComponent);
begin
如果FParent<>然后
开始
如果分配(FParent)然后
FParent.FChilds.Remove(Self);
FParent:= Value;
如果分配(FParent)然后
FParent.FChilds.Add(Self);
结束
结束
procedure TChildComponent.SetParentComponent(AParent:TComponent);
begin
如果AParent是TParentComponent,那么
SetParent(AParent as TParentComponent);
结束
{TParentComponent}
构造函数TParentComponent.Create(AOwner:TComponent);
开始
继承;
FChilds:= TList.Create;
结束
析构函数TParentComponent.Destroy;
var
I:整数;
begin
for I:= 0 to FChilds.Count - 1 do
TComponent(FChilds [0])。
FChilds.Free;
继承;
结束
procedure TParentComponent.GetChildren(Proc:TGetChildProc; Root:TComponent);
var
i:整数;
begin
for i:= 0 to FChilds.Count - 1 do
Proc(TComponent(FChilds [i]));
结束
{TChildComponentCollectionItem}
构造函数TChildComponentCollectionItem.Create(Collection:TCollection);
开始
继承;
如果Assigned(Collection)然后
begin
FChildComponent:= TChildComponent.Create(TComponent(TOwnedCollection(Collection).Owner).Owner);
FChildComponent.Name:= TChildComponentCollection(Collection).Designer.UniqueName(TChildComponent.ClassName);
FChildComponent.Parent:= TParentComponent(TComponent(TOwnedCollection(Collection).Owner));
结束
结束
析构函数TChildComponentCollectionItem.Destroy;
begin
FChildComponent.Free;
继承;
结束
函数TChildComponentCollectionItem.GetDisplayName:string;
begin
结果:= FChildComponent.Name;
结束
函数TChildComponentCollectionItem.GetName:string;
begin
结果:= FChildComponent.Name;
结束
函数TChildComponentCollectionItem.GetOnTest:TNotifyEvent;
begin
结果:= FChildComponent.OnTest;
结束
程序TChildComponentCollectionItem.SetName(const value:string);
begin
FChildComponent.Name:= Value;
结束
procedure TChildComponentCollectionItem.SetOnTest(const Value:TNotifyEvent);
begin
FChildComponent.OnTest:= Value;
结束
{TParentPropertyEditor}
程序TParentPropertyEditor.Edit;
var
LCollection:TChildComponentCollection;
i:整数;
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 (GetComponent(0))童车[I])TParentComponent;
集合:= LCollection;
结束
ShowCollectionEditorClass(Designer,TCollectionEditor,TComponent(GetComponent(0)),LCollection,'Childs');
结束
函数TParentPropertyEditor.GetAttributes:TPropertyAttributes;
begin
结果:= [paDialog];
结束
函数TParentPropertyEditor.GetValue:string;
begin
结果:='Childs';
结束
结束。
上述来源适应于 StackOverflow上的另一个答案。
任何想法为什么我无法创建一个方法
>解决方案
设计时间要求摘要
- 您需要或需要一个能够容纳多个子级的自定义组件组件。
- 这些子组件将由该自定义组件创建。
- 子组件需要能够在代码中被引用名称作为设计时间的任何正常组件;因此不是
Form.CustomComponent.Children [0]
,而是Form.Child1
。 - 因此,子组件需要在模块(一个Form,Frame或DataModule)的源文件中被声明,从而被添加到该文件中。
- 子组件是要由默认的IDE集合编辑器管理。
- 因此,一个孩子需要完全被包装到一个
TCollectionItem
中。 >
评估当前代码
你已经很好了,除了你的问题代码有几点要改进:
- 您创建的集合永远不会被释放。
- 每次显示收藏编辑器时都会创建一个新集合。
- 如果您从TreeView中删除一个小孩,则旧的相应CollectionItem将保留,从而导致AV。
- 设计时间和运行时代码不分割。
Soluti在
以下是您的代码的重写工作版本,并进行了以下更改:
- 特殊组件称为
Master
,因为父与Delphi的父母
(已经有两种)。因此,一个孩子被称为奴隶
。 - 奴隶持有
TComponentList
(单位Contnrs
)自动更新列表,以防个别从属设备销毁。 ComponentList拥有从属。 - 对于每一个Master,只创建一个Collection。这些Master-Collection-组合被保存在一个单独的
TStockItems
ObjectList中。列表拥有库存项目,列表在Finalization部分中被释放。 -
GetNamePath
被实现,从而显示从属作为Slave1
在对象检查器中,而不是SlaveWrappers(0)
。 - 为TSlaveWrapper类的事件添加了一个额外的属性编辑器。不知何故
GetFormMethodName
的默认TMethodProperty
会导致您遇到的错误。原因将在Designer.GetObjectName
中,但我不知道为什么。现在GetFormMethodName
被覆盖,这可以解决您的问题。
备注
收藏夹中的项目顺序(使用集合编辑器的箭头按钮)所做的更改尚未保留。尝试自己实现。
在TreeView中,每个奴隶现在是主人的直接孩子,而不是奴隶的孩子
属性,通常与集合一起看到:
为了实现这一点,我认为 TSlaves
应该从 TPersistent
,而ComponentList将被包装在其中。
组件代码
unit MasterSlave ;
接口
使用
类,Contnrs;
type
TMaster = class;
TSlave = class(TComponent)
private
FMaster:TMaster;
FOnTest:TNotifyEvent;
程序SetMaster(Value:TMaster);
protected
procedure SetParentComponent(AParent:TComponent);覆盖;
public
函数GetParentComponent:TComponent;覆盖;
函数HasParent:Boolean;覆盖;
属性Master:TMaster读取FMaster写SetMaster;
发布
属性OnTest:TNotifyEvent读取FOnTest写入FOnTest;
结束
TSlaves = class(TComponentList)
private
函数GetItem(Index:Integer):TSlave;
procedure SetItem(Index:Integer; Value:TSlave);
public
属性项目[索引:整数]:TSlave读取GetItem写入SetItem;默认;
结束
TMaster = class(TComponent)
private
FSlaves:TSlaves;
protected
procedure GetChildren(Proc:TGetChildProc; Root:TComponent);覆盖;
public
构造函数Create(AOwner:TComponent);覆盖;
析构函数覆盖;
发布
属性从属:TSlaves读取FSlaves;
结束
实现
{TSlave}
函数TSlave.GetParentComponent:TComponent;
begin
结果:= FMaster;
结束
函数TSlave.HasParent:Boolean;
begin
结果:= FMaster<>零;
结束
程序TSlave.SetMaster(Value:TMaster);
begin
如果FMaster<>值
begin
如果FMaster<> nil then
FMaster.FSlaves.Remove(Self);
FMaster:= Value;
如果FMaster<> nil then
FMaster.FSlaves.Add(Self);
结束
结束
程序TSlave.SetParentComponent(AParent:TComponent);
begin
如果AParent是TMaster,那么
SetMaster(TMaster(AParent));
结束
{TSlaves}
函数TSlaves.GetItem(Index:Integer):TSlave;
begin
结果:= TSlave(inherited Items [Index]);
结束
程序TSlaves.SetItem(Index:Integer; Value:TSlave);
begin
inherited Items [Index]:= Value;
结束
{TMaster}
构造函数TMaster.Create(AOwner:TComponent);
begin
继承Create(AOwner);
FSlaves:= TSlaves.Create(True);
结束
析构函数TMaster.Destroy;
begin
FSlaves.Free;
继承了Destroy;
结束
程序TMaster.GetChildren(Proc:TGetChildProc; Root:TComponent);
var
I:整数;
begin
for I:= 0 to FSlaves.Count - 1 do
Proc(FSlaves [I]);
结束
结束。
编辑器代码
code> unit MasterSlaveEdit;
接口
使用
类,SysUtils,MasterSlave,Contnrs,DesignEditors,DesignIntf,ColnEdit;
type
TMasterEditor = class(TComponentEditor)
private
函数主:TMaster;
public
procedure ExecuteVerb(Index:Integer);覆盖;
函数GetVerb(Index:Integer):String;覆盖;
函数GetVerbCount:Integer;覆盖;
结束
TMasterProperty = class(TPropertyEditor)
private
函数主:TMaster;
public
程序编辑;覆盖;
函数GetAttributes:TPropertyAttributes;覆盖;
函数GetValue:String;覆盖;
结束
TOnTestProperty = class(TMethodProperty)
private
函数从属:TSlave;
public
函数GetFormMethodName:String;覆盖;
结束
TSlaveWrapper = class(TCollectionItem)
private
FSlave:TSlave;
函数GetName:String;
函数GetOnTest:TNotifyEvent;
程序SetName(const Value:String);
程序SetOnTest(Value:TNotifyEvent);
protected
function GetDisplayName:String;覆盖;
public
构造函数Create(Collection:TCollection);覆盖;
构造函数CreateSlave(Collection:TCollection; ASlave:TSlave);
析构函数覆盖;
函数GetNamePath:String;覆盖;
发布
属性名称:String读取GetName写入SetName;
属性OnTest:TNotifyEvent读取GetOnTest写入SetOnTest;
结束
TSlaveWrappers = class(TOwnedCollection)
private
函数GetItem(Index:Integer):TSlaveWrapper;
public
属性项目[索引:整数]:TSlaveWrapper读取GetItem;默认;
结束
实现
类型
TStockItem =类(TComponent)
protected
集合:TSlaveWrappers;
设计师:IDesigner;
硕士:TMaster;
程序通知(ACComponent:TComponent;操作:TOperation);
覆盖;
public
析构函数Destroy;覆盖;
结束
TStockItems = class(TObjectList)
private
function GetItem(Index:Integer):TStockItem;
protected
function CollectionOf(AMaster:TMaster; Designer:IDesigner):TCollection;
函数Find(ACollection:TCollection):TStockItem;
属性项[Index:Integer]:TStockItem读取GetItem;
默认值
结束
var
FStock:TStockItems = nil;
函数库存:TStockItems;
begin
如果FStock = nil then
FStock:= TStockItems.Create(True);
结果:= FStock;
结束
{TStockItem}
析构函数TStockItem.Destroy;
begin
Collection.Free;
继承了Destroy;
结束
程序TStockItem.Notification(AComponent:TComponent;
操作:TOperation);
var
I:整数;
begin
继承的通知(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);
休息;
结束
结束
{TStockItems}
函数TStockItems.CollectionOf(AMaster:TMaster;
设计器:IDesigner):TCollection;
var
I:整数;
项目:TStockItem;
begin
结果:= nil;
为I:= 0到Count - 1 do
如果Items [I] .Master = AMaster then
begin
结果:= Items [I] .Collection;
休息;
结束
如果Result = nil then
begin
Item:= TStockItem.Create(nil);
Item.Master:= AMaster;
Item.Designer:= Designer;
Item.Collection:= TSlaveWrappers.Create(AMaster,TSlaveWrapper);
为I:= 0到AMaster.Slaves.Count - 1 do
begin
TSlaveWrapper.CreateSlave(Item.Collection,AMaster.Slaves [I]);
Item.FreeNotification(AMaster.Slaves [I]);
结束
添加(Item);
结果:= Item.Collection;
结束
结束
函数TStockItems.GetItem(Index:Integer):TStockItem;
begin
结果:= TStockItem(inherited Items [Index]);
结束
函数TStockItems.Find(ACollection:TCollection):TStockItem;
var
I:整数;
begin
结果:= nil;
对于I:= 0到Count - 1 do
如果Items [I] .Collection = ACollection then
begin
结果:= Items [I];
休息;
结束
结束
{TMasterEditor}
程序TMasterEditor.ExecuteVerb(Index:Integer);
begin
case索引
0:ShowCollectionEditor(Designer,Master,
Stock.CollectionOf(Master,Designer),'Slaves');
结束
结束
函数TMasterEditor.GetVerb(Index:Integer):String;
begin
case索引
0:结果:='编辑从属...';
else
结果:='';
结束
结束
函数TMasterEditor.GetVerbCount:Integer;
begin
结果:= 1;
结束
函数TMasterEditor.Master:TMaster;
begin
结果:= TMaster(Component);
结束
{TMasterProperty}
程序TMasterProperty.Edit;
begin
ShowCollectionEditor(Designer,Master,
Stock.CollectionOf(Master,Designer),'Slaves');
结束
函数TMasterProperty.GetAttributes:TPropertyAttributes;
begin
结果:= [paDialog];
结束
函数TMasterProperty.GetValue:String;
begin
结果:=格式('(%s)',[Master.Slaves.ClassName]);
结束
函数TMasterProperty.Master:TMaster;
begin
结果:= TMaster(GetComponent(0));
结束
{TonTestProperty}
函数TOnTestProperty.GetFormMethodName:String;
begin
结果:= Slave.Name + GetTrimmedEventName;
结束
函数TOnTestProperty.Slave:TSlave;
begin
结果:= TSlaveWrapper(GetComponent(0))。
结束
{TSlaveWrapper}
构造函数TSlaveWrapper.Create(Collection:TCollection);
begin
CreateSlave(Collection,nil);
结束
构造函数TSlaveWrapper.CreateSlave(Collection:TCollection; ASlave:TSlave);
var
项目:TStockItem;
begin
继承Create(Collection);
如果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;
结束
析构函数TSlaveWrapper.Destroy;
begin
FSlave.Free;
继承了Destroy;
结束
函数TSlaveWrapper.GetDisplayName:String;
begin
结果:=名称;
结束
函数TSlaveWrapper.GetName:String;
begin
结果:= FSlave.Name;
结束
函数TSlaveWrapper.GetNamePath:String;
begin
结果:= FSlave.GetNamePath;
结束
函数TSlaveWrapper.GetOnTest:TNotifyEvent;
begin
结果:= FSlave.OnTest;
结束
procedure TSlaveWrapper.SetName(const Value:String);
begin
FSlave.Name:= Value;
结束
程序TSlaveWrapper.SetOnTest(Value:TNotifyEvent);
begin
FSlave.OnTest:= Value;
结束
{TSlaveWrappers}
函数TSlaveWrappers.GetItem(Index:Integer):TSlaveWrapper;
begin
结果:= TSlaveWrapper(inherited Items [Index]);
结束
初始化
finalization
FStock.Free;
结束。
注册码
code> unit MasterSlaveReg;
界面
使用
Classes,MasterSlave,MasterSlaveEdit,DesignIntf;
程序注册;
执行
程序注册;
begin
RegisterClass(TSlave);
RegisterNoIcon([TSlave]);
RegisterComponents('Samples',[TMaster]);
RegisterComponentEditor(TMaster,TMasterEditor);
RegisterPropertyEditor(TypeInfo(TSlaves),TMaster,'Slaves',
TMasterProperty);
RegisterPropertyEditor(TypeInfo(TNotifyEvent),TSlaveWrapper,'OnTest',
TOnTestProperty);
结束
结束。
包代码
code>需要
rtl,
DesignIDE;
在'MasterSlave.pas'中包含
MasterSlave,'masterSlaveEdit.pas'中的
MasterSlaveEdit,'MasterSlaveReg.pas'中的
MasterSlaveReg;
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]
, butForm.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'sParent
(there are two kind already). Therefore a child is calledSlave
. - Slaves are held in a
TComponentList
(unitContnrs
) 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 asSlave1
in the Object Inspector, instead of asSlaveWrappers(0)
.- An extra property editor is added for the event of the TSlaveWrapper class. Somehow
GetFormMethodName
of the defaultTMethodProperty
results in the error you are getting. The cause will ly inDesigner.GetObjectName
, but I do not know exactly why. NowGetFormMethodName
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';
这篇关于“无法创建未命名组件的方法”的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!