The following code (when registered in a package) gives us a component called TParentComponent
registered in the pallet Test
.
However, when you
Form.CustomComponent.Children[0]
, but Form.Child1
instead.TCollectionItem
.You are going quite well already, but besides your question, the code has a few points for improvement:
Here is a rewritten, working version of your code, with the following changes:
Master
, because Parent confuses too much with Delphi's Parent
(there are two kind already). Therefore a child is called Slave
.TComponentList
(unit Contnrs
) to automatically update the list in case of individual slave destruction. The ComponentList owns the slaves.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)
.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.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.
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.
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.
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.
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).