“无法创建未命名组件的方法” [英] "Cannot create a method for an unnamed component"

查看:209
本文介绍了“无法创建未命名组件的方法”的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

以下代码(在程序包中注册时)向我们提供了一个名为 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(M​​aster,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(M​​aster,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], 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';

这篇关于“无法创建未命名组件的方法”的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆