Using TOwnedCollection descendant in Delphi - delphi

I'm trying to create a custom component with a collection property. However if I try to open the collection editor during design time by clicking "..." button in object inspector, nothing happens. What I am missing?
Here's my TCollection descendant:
TMyCollection = class(TOwnedCollection)
private
function GetItem(Index: Integer): TMyCollectionItem;
procedure SetItem(Index: Integer; const Value: TMyCollectionItem);
public
function Add : TMyCollectionItem;
property Items[Index: Integer]: TMyCollectionItem read GetItem write SetItem;
end;
And the item:
TMyCollectionItem = class(TCollectionItem)
private
FValue: integer;
protected
function GetDisplayName: string; override;
public
procedure Assign(Source: TPersistent); override;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property Value : integer read FValue write FValue;
end;

Your class definitions look correct so with out seeing the entire implementation I don't know what the problem is.
Here is a simple unit I've written that uses TOwnedCollection, TCollectionItem and TComponent.
I know this unit works. Use it as a basis for checking your code.
unit rmMultiStrings;
interface
uses classes, sysutils;
type
ErmMultiStringNameException = Exception;
TrmMultiStringsCollection = class;
TrmMultiStringCollectionItem = class(TCollectionItem)
private
fItemDesc: string;
fItemName: string;
fData : TStringList;
fMultiStrings : TrmMultiStringsCollection;
function GetStrings: TStringList;
function GetStringText: String;
procedure SetItemName(const Value: string);
procedure SetStrings(const Value: TStringList);
procedure SetStringText(const Value: String);
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property ItemName : string read fItemName write SetItemName;
property Description : string read fItemDesc write fItemDesc;
property Strings : TStringList read GetStrings write SetStrings stored false;
property Text : String read GetStringText write SetStringText;
end;
TrmMultiStringsCollection = class(TOwnedCollection)
private
function GetItem(AIndex: integer): TrmMultiStringCollectionItem;
procedure SetItem(AIndex: integer; const Value: TrmMultiStringCollectionItem);
public
function Add: TrmMultiStringCollectionItem;
function IndexOf(ItemName:string):integer;
function ValueOf(ItemName:string):String;
function ValueOfIndex(aIndex:integer):string;
procedure Assign(Source: TPersistent); override;
property Items[AIndex: integer] : TrmMultiStringCollectionItem read GetItem write SetItem;
end;
TrmMultiStrings = class(TComponent)
private
fData : TrmMultiStringsCollection;
procedure SetData(const Value: TrmMultiStringsCollection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function IndexOf(ItemName:string):integer;
function ValueOf(ItemName:string):String;
function ValueOfIndex(aIndex:integer):string;
published
property Data : TrmMultiStringsCollection read fData write SetData;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterClass(TrmMultiStringsCollection);
RegisterClass(TrmMultiStringCollectionItem);
RegisterComponents('rmConcordia', [TrmMultiStrings]);
end;
{ TrmMultiStringCollectionItem }
procedure TrmMultiStringCollectionItem.Assign(Source: TPersistent);
var
wSrc : TrmMultiStringCollectionItem;
begin
if Source is TrmMultiStringCollectionItem then
begin
wSrc := TrmMultiStringCollectionItem(Source);
ItemName := wSrc.ItemName;
Description := wSrc.Description;
Text := wSrc.Text;
end
else
inherited;
end;
constructor TrmMultiStringCollectionItem.Create(Collection: TCollection);
begin
inherited;
fMultiStrings := TrmMultiStringsCollection(Collection);
fData := TStringList.create;
end;
destructor TrmMultiStringCollectionItem.Destroy;
begin
fData.free;
inherited;
end;
function TrmMultiStringCollectionItem.GetStrings: TStringList;
begin
result := fData;
end;
function TrmMultiStringCollectionItem.GetStringText: String;
begin
result := fData.Text;
end;
procedure TrmMultiStringCollectionItem.SetItemName(const Value: string);
begin
if (fItemName <> Value) then
begin
if fMultiStrings.IndexOf(Value) = -1 then
fItemName := Value
else
raise ErmMultiStringNameException.Create('Item name already exists');
end;
end;
procedure TrmMultiStringCollectionItem.SetStrings(
const Value: TStringList);
begin
fData.Assign(Value);
end;
procedure TrmMultiStringCollectionItem.SetStringText(const Value: String);
begin
fData.Text := Value;
end;
{ TrmMultiStringsCollection }
function TrmMultiStringsCollection.Add: TrmMultiStringCollectionItem;
begin
result := TrmMultiStringCollectionItem(inherited Add);
result.ItemName := 'Item_'+inttostr(NextID);
end;
procedure TrmMultiStringsCollection.Assign(Source: TPersistent);
var
wSrc : TrmMultiStringsCollection;
loop : integer;
begin
if (source is TrmMultiStringsCollection) then
begin
wSrc := TrmMultiStringsCollection(Source);
Clear;
for loop := 0 to wSrc.Count - 1 do
Add.Assign(wSrc.Items[loop]);
end
else
inherited;
end;
function TrmMultiStringsCollection.GetItem(
AIndex: integer): TrmMultiStringCollectionItem;
begin
result := TrmMultiStringCollectionItem(inherited Items[AIndex]);
end;
function TrmMultiStringsCollection.IndexOf(ItemName: string): integer;
var
loop : integer;
begin
result := -1;
loop := 0;
while (result = -1) and (loop < Count) do
begin
if (CompareText(Items[loop].ItemName, ItemName) = 0) then
result := loop
else
inc(loop);
end;
end;
procedure TrmMultiStringsCollection.SetItem(AIndex: integer; const Value: TrmMultiStringCollectionItem);
begin
inherited SetItem(AIndex, Value)
end;
function TrmMultiStringsCollection.ValueOf(ItemName: string): String;
begin
result := ValueOfIndex(IndexOf(ItemName));
end;
function TrmMultiStringsCollection.ValueOfIndex(aIndex: integer): string;
begin
if (aIndex >= 0) and (aIndex < Count) then
result := Items[aIndex].Text
else
result := '';
end;
{ TrmMultiStrings }
constructor TrmMultiStrings.Create(AOwner: TComponent);
begin
inherited;
fData := TrmMultiStringsCollection.Create(self, TrmMultiStringCollectionItem);
end;
destructor TrmMultiStrings.Destroy;
begin
fData.Free;
inherited;
end;
function TrmMultiStrings.IndexOf(ItemName: string): integer;
begin
result := Data.IndexOf(ItemName);
end;
procedure TrmMultiStrings.SetData(const Value: TrmMultiStringsCollection);
begin
fData.Assign(Value);
end;
function TrmMultiStrings.ValueOf(ItemName: string): String;
begin
result := Data.ValueOf(ItemName);
end;
function TrmMultiStrings.ValueOfIndex(aIndex: integer): string;
begin
result := Data.ValueOfIndex(aIndex);
end;
end.

Related

Object Pascal call or invoke descendant's method from base class

I have this object in mind:
TBaseObject = class
private
FEditState: string;
FID: integer;
public
constructor Create;
...
procedure Clone(AObject: TObject); virtual; //I actually want AObject to be generic
property EditState: string read FEditState write FEditState;
property ID: integer read FID write FID;
end;
constructor TBaseObject.Create;
begin
FEditState := 'none';
end;
Here is one descendant class:
TUser = class(TBaseObject)
private
FUsername: string;
public
procedure Clone(AObject: TObject); override;
property Username: string read FUsername write FUsername;
...
end;
...
procedure TUser.Clone(AObject: TObject);
begin
self.id := aobject.id;
...
end;
Then I make a container object as follows:
TBaseObjects<T:class> = class
private
FItems: TObjectList<T>;
FDeletedItems: TObjectList<T>;
function GetItem(Index: Integer): T;
public
function Add(NewItem: T=Default(T)): T; // adds to FItems
function DeleteItem(AObject: T): T; // save to FDeletedItems, delete from FItems
property Items[Index: Integer]: T read GetItem; default;
...
function TBaseObjects<T>.DeleteItem(AObject: T): T;
begin
result := T.Create;
result.Clone(AObject); // ERROR: no member Clone...
FItems.Remove(...);
end;
Used as:
TUsers = TBaseBOMList<TUser>;
var
Users: TUsers;
As can be seen, I try to save a copy of the item to be deleted into FDeletedItems generic list by using the descendant's clone method, then delete from FItems, but fails. The compiler say 'no member Clone'.
If what I'm doing can't be done, how is this supposed to be handled?
As suggested by Dalija, I declared TBaseObjects<T:TBaseObject> instead of TBaseObjects<T:class>.
For anybody curious or interested, the complete test program is available below.
Also, if someone can do this more efficiently with with pure polymorpism rather than generics as implied by DelphiCoder, I'd gladly reconsider, because as it is now, wthout Generics, I would have to declare and define one TBaseBOMList and duplicate every method for every base object (TUser, TRole, etc.) I want to use.
Code:
program ProjTestGenerics;
{$mode delphi}
uses
sysutils, TypInfo, generics.Collections;
type
{ TBaseBOM }
TBaseBOM = class
private
FEditState: string;
FID: integer;
public
constructor Create;
procedure Assign(src: TBaseBOM);
published
property EditState: string read FEditState write FEditState;
property ID: integer read FID write FID;
end;
{ TBaseBOMList }
TBaseBOMList<T:TBaseBOM> = class
private
FItems: TObjectList<T>;
FDeletedItems: TObjectList<T>;
function GetItem(Index: Integer): T;
public
constructor Create;
destructor Destroy; override;
function Add(NewItem: T=Default(T)): T;
function Delete(Index: Integer): Boolean;
function Find(APropertyName: string; const AValue: variant): Integer;
property Items[Index: Integer]: T read GetItem; default;
end;
{ TRole }
TRole = class(TBaseBOM)
private
FRolename: string;
public
procedure Assign( AObject: TBaseBOM );
published
property Rolename: string read FRolename write FRolename;
end;
{ TUser }
TUser = class(TBaseBOM)
private
FUsername: string;
public
procedure Assign( AObject: TBaseBOM );
published
property Username: string read FUsername write FUsername;
end;
{ TUserRole }
TUserRole = class(TBaseBOM)
private
FRolename: string;
FUsername: string;
public
procedure Assign( AObject: TBaseBOM );
published
property Username: string read FUsername write FUsername;
property Rolename: string read FRolename write FRolename;
end;
TUsers = TBaseBOMList<TUser>;
TRoles = TBaseBOMList<TRole>;
TUserRoles = TBaseBOMList<TUserRole>;
function TBaseBOMList<T>.GetItem(Index: Integer): T;
begin
result := FItems[Index];
end;
constructor TBaseBOMList<T>.Create;
begin
inherited Create;
FItems := TObjectList<T>.Create(true);
FDeletedItems := TObjectList<T>.Create(true);
end;
destructor TBaseBOMList<T>.Destroy;
begin
FDeletedItems.Free;
FItems.Free;
inherited Destroy;
end;
function TBaseBOMList<T>.Add(NewItem: T): T;
begin
if NewItem = Default(T) then
result := T.Create
else
result := NewItem;
FItems.Add(result);
end;
function TBaseBOMList<T>.Delete(Index: Integer): Boolean;
var
o: T;
begin
o := T.Create;
o.Assign(FItems[Index]);
FDeletedItems.Add(o);
FItems.Delete(Index); // error if index not valid
result := true;
end;
function TBaseBOMList<T>.Find(APropertyName: string; const AValue: variant
): Integer;
var
value : Variant;
PropList: PPropList;
PropCount, i: integer;
PropExist: Boolean;
begin
Result := -1;
PropExist:= False;
PropCount := GetPropList(T, PropList);
try
for i := 0 to PropCount-1 do
if CompareText(PropList[i].Name, APropertyName) = 0 then
begin
PropExist := True;
break;
end;
finally
Freemem(PropList);
end;
if PropExist then
begin
for i := 0 to FItems.Count-1 do
begin
value := GetStrProp(FItems[i], APropertyName);
if value = AValue then
begin
Result := i;
end;
end;
end
else
Raise Exception.Create(Format('Property name ''%s'' not found.',[APropertyName]));
end;
procedure TUserRole.Assign(AObject: TBaseBOM);
begin
inherited Assign(AObject);
with TUserRole(AObject) do
begin
self.Rolename:= Rolename;
self.Username:= Username;
end;
end;
procedure TRole.Assign(AObject: TBaseBOM);
begin
with TRole(AObject) do
self.Rolename:= Rolename;
end;
procedure TUser.Assign(AObject: TBaseBOM);
begin
with TUser(AObject) do
self.Username:= Username;
end;
{ TBaseBOM }
constructor TBaseBOM.Create;
begin
FEditState:= 'none';
end;
procedure TBaseBOM.Assign(src: TBaseBOM);
begin
with src do
begin
self.ID:= src.ID;
self.EditState:= src.EditState;
end;
end;
var
users: TUsers;
roles: TRoles;
u: TUser;
r: TRole;
urs: TUserRoles;
ur: TUserRole;
i: Integer;
begin
roles := TRoles.Create;
r := TRole.Create;
r.Rolename:= 'admin';
roles.Add(r);
r := roles.Add;
r.rolename := 'processor';
users := TUsers.Create;
u := TUser.Create;
u.Username:= 'magic';
users.Add(u);
urs := TUserRoles.Create;
ur := TUserRole.Create;
ur.ID:= 999;
ur.Username:= 'magic';
ur.Rolename:= 'processor';
urs.Add(ur);
writeln('Find username magic');
i := users.Find('username', 'magic');
writeln(users[i].username);
writeln('Find role ''processor''');
i := roles.Find('rolename', 'processor');
writeln(roles[i].rolename);
writeln('Delete last found role');
roles.Delete(i);
writeln('Deleted roles:');
writeln(roles.FDeletedItems[0].Rolename);
writeln('Find rolename ''processor'' in user roles');
i := urs.Find('rolename', 'processor');
writeln(urs[i].Rolename, ' / ', urs[i].Username);
writeln('Delete rolename ''processor'' in user roles');
urs.Delete(i);
writeln(urs.FDeletedItems[0].Rolename, ' / ', urs.FDeletedItems[0].Username);
writeln(urs.FDeletedItems[0].ID, ' / ', urs.FDeletedItems[0].EditState);
urs.free;
users.free;
roles.free;
writeln('ok');
readln();
end.

"Cannot create a method for an unnamed component"

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

Event in descendant of TCollectionItem

I wrote simple code (see below): a descendant of TCollectionItem with an event. But when I click OnDone event in object inspector I get the message:
"Cannot create a method for an unnamed component".
What is wrong with this code?
unit MainComponent2;
interface
uses Windows, SysUtils, Classes;
type
TMyField = class(TCollectionItem)
private
FName: string;
FOnDone: TNotifyEvent;
FText: string;
protected
function GetDisplayName : String; override;
public
constructor Create(ACollection: TCollection);override;
function GetNamePath: string;override;
published
property Name: string read FName write FName;
property Text: string read FText write FText;
property OnDone: TNotifyEvent read FOnDone write FOnDone;
end;
TMyFields = class(TOwnedCollection)
private
function GetItem(Index: Integer): TMyField;
procedure SetItem(Index: Integer; const Value: TMyField);
protected
procedure Update(Item: TmyField);reintroduce;
public
constructor Create(AOwner: TComponent);
function Add: TMyField;
function Insert(Index: Integer): TMyField;
property Items[Index: Integer]: TMyField read GetItem write SetItem; default;
end;
TMainComponent2 = class(TComponent)
private
FMyFields: TMyFields;
function GetItem(index: integer): TMyField;
procedure SetItem(index: integer; const Value: TMyField);
procedure SetMyFields(const Value: TMyFields);
public
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
property Items[index: integer]: TMyField read GetItem write SetItem;
published
property MyFields: TMyFields read FMyFields write SetMyFields;
end;
procedure Register;
implementation
{ TMainComponent2 }
constructor TMainComponent2.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMyFields := TMyFields.Create(AOwner);
end;
destructor TMainComponent2.Destroy;
begin
FMyFields.Free;
inherited;
end;
function TMainComponent2.GetItem(index: integer): TMyField;
begin
result := FMyFields.Items[index] as TMyField;
end;
procedure TMainComponent2.SetItem(index: integer; const Value: TMyField);
begin
FMyFields.Items[index] := Value;
end;
procedure TMainComponent2.SetMyFields(const Value: TMyFields);
begin
FMyFields.Assign(Value);
end;
{ TMyField }
constructor TMyField.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FName := ClassName + IntToStr(ID);
end;
function TMyField.GetDisplayName: String;
begin
result := FName;
end;
function TMyField.GetNamePath: string;
begin
Result := Format('%s%d',['MyField', Index])
end;
{ TMyFields }
function TMyFields.Add: TMyField;
begin
result := (inherited Add) as TMyField;
end;
constructor TMyFields.Create(AOwner: TComponent);
begin
inherited Create(AOwner, TMyField);
end;
function TMyFields.GetItem(Index: Integer): TMyField;
begin
result := (inherited GetItem(Index)) as TMyField;
end;
function TMyFields.Insert(Index: Integer): TMyField;
begin
result := (inherited Insert(Index)) as TMyField;
end;
procedure TMyFields.SetItem(Index: Integer; const Value: TMyField);
begin
inherited SetItem(Index, Value);
end;
procedure TMyFields.Update(Item: TmyField);
begin
inherited Update(Item);
end;
procedure Register;
begin
RegisterComponents('MyComponents', [TMainComponent2]);
end;
end.
You forgot to include the inherited name path of TMyField:
function TMyField.GetNamePath: string;
begin
Result := inherited GetNamePath + Format('MyField%d',[Index]);
end;
Also, you have given the wrong owner for the MyFields property. Use Self instead of AOwner. AOwner is the form on which you drop the component.
constructor TMainComponent2.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMyFields := TMyFields.Create(Self);
end;
B.t.w. Why did you reintroduce TMyFields.Update? This breaks the inheritance chain. Use override when possible, or add another method.

Creating a component with named sub-components?

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.

TCollectionItem not initializing default property values

I've been fighting this crazy problem for hours and have gotten nowhere. I have this problem in two completely different projects using a TCollection. When a new collection item is added, I need to initialize the values of that item. However, they're not defaulting at all. I'm even setting them in two completely different places, in the item's constructor, and in the collection's add function - neither of them are working. I can set the values once the items are there, but I need to set default values. I've done collections in the past and never had this problem, I must be missing something here...
unit JDGrids;
interface
uses
Classes, Windows, SysUtils, Grids, StrUtils;
type
TJDGridCol = class;
TJDGridCols = class;
TJDGridCols = class(TCollection)
private
fOnEvent: TNotifyEvent;
private
fOwner: TComponent;
procedure DoEvent;
property OnEvent: TNotifyEvent read fOnEvent write fOnEvent;
protected
function GetItem(Index: Integer): TJDGridCol;
procedure SetItem(Index: Integer; Value: TJDGridCol);
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
function Add: TJDGridCol;
procedure Assign(Source: TPersistent); override;
procedure Clear;
procedure Delete(Index: Integer);
property Items[Index: Integer]: TJDGridCol read GetItem write SetItem; default;
end;
TJDGridCol = class(TCollectionItem)
private
fOwner: TComponent;
fWidth: Integer;
fTitle: String;
fCols: TJDGridCols;
fOnEvent: TNotifyEvent;
fVisible: Bool;
procedure SetTitle(const Value: String);
procedure SetWidth(const Value: Integer);
procedure DoEvent;
property OnEvent: TNotifyEvent read fOnEvent write fOnEvent;
procedure SetVisible(const Value: Bool);
protected
function GetDisplayName: String; override;
public
constructor Create(AOwner: TJDGridCols);
destructor Destroy; override;
published
property Title: String read fTitle write SetTitle;
property Width: Integer read fWidth write SetWidth;
property Visible: Bool read fVisible write SetVisible;
end;
implementation
{ TJDGridCols }
constructor TJDGridCols.Create(AOwner: TComponent);
begin
inherited Create(TJDGridCol);
fOwner:= AOwner;
end;
destructor TJDGridCols.Destroy;
begin
inherited Destroy;
end;
function TJDGridCols.Add: TJDGridCol;
begin
Result:= TJDGridCol(inherited Add);
Result.fCols:= Self;
Result.fTitle:= 'Column '+IntToStr(Result.ID);
Result.fWidth:= 30;
Result.fVisible:= True;
DoEvent;
end;
procedure TJDGridCols.Assign(Source: TPersistent);
begin
inherited Assign(Source);
DoEvent;
end;
procedure TJDGridCols.Clear;
begin
inherited Clear;
DoEvent;
end;
procedure TJDGridCols.Delete(Index: Integer);
begin
inherited Delete(Index);
DoEvent;
end;
function TJDGridCols.GetItem(Index: Integer): TJDGridCol;
begin
Result:= TJDGridCol(inherited Items[Index]);
end;
function TJDGridCols.GetOwner: TPersistent;
begin
Result:= fOwner;
end;
procedure TJDGridCols.SetItem(Index: Integer; Value: TJDGridCol);
begin
inherited Items[Index]:= Value;
DoEvent;
end;
procedure TJDGridCols.DoEvent;
begin
if assigned(fOnEvent) then fOnEvent(Self);
end;
{ TJDGridCol }
constructor TJDGridCol.Create(AOwner: TJDGridCols);
begin
inherited Create(AOwner);
fOwner:= AOwner.fOwner;
fCols:= AOwner;
fTitle:= 'Column '+IntToStr(ID);
fWidth:= 30;
fVisible:= True;
end;
destructor TJDGridCol.Destroy;
begin
inherited Destroy;
end;
procedure TJDGridCol.DoEvent;
begin
if assigned(fOnEvent) then fOnEvent(Self);
end;
function TJDGridCol.GetDisplayName: String;
begin
Result:= fTitle;
end;
procedure TJDGridCol.SetTitle(const Value: String);
begin
fTitle:= Value;
DoEvent;
end;
procedure TJDGridCol.SetVisible(const Value: Bool);
begin
fVisible := Value;
DoEvent;
end;
procedure TJDGridCol.SetWidth(const Value: Integer);
begin
fWidth := Value;
DoEvent;
end;
end.
You are not overriding the constructor of TCollection, so TCollection.Add() cannot call your constructor. That is why you needed to have Add() set the default values.
Even then, you are setting default property values during construction, but you are not specifying those same default values in your property declarations. You need to do so for DFM streaming to work correctly.
You should also use TOwnedCollection instead of using TCollection directly. Let TOwnedCollection manage the Owner for you.
Try this:
unit JDGrids;
interface
uses
Classes, Windows, SysUtils, Grids, StrUtils;
type
TJDGridCol = class;
TJDGridCols = class(TOwnedCollection)
private
fOnEvent: TNotifyEvent;
private
procedure DoEvent;
property OnEvent: TNotifyEvent read fOnEvent write fOnEvent;
protected
function GetItem(Index: Integer): TJDGridCol;
procedure SetItem(Index: Integer; Value: TJDGridCol);
public
constructor Create(AOwner: TComponent); reintroduce;
destructor Destroy; override;
function Add: TJDGridCol; reintroduce;
procedure Assign(Source: TPersistent); override;
procedure Clear; reintroduce;
procedure Delete(Index: Integer); reintroduce;
property Items[Index: Integer]: TJDGridCol read GetItem write SetItem; default;
end;
TJDGridCol = class(TCollectionItem)
private
fWidth: Integer;
fTitle: String;
fOnEvent: TNotifyEvent;
fVisible: Bool;
procedure SetTitle(const Value: String);
procedure SetWidth(const Value: Integer);
procedure DoEvent;
procedure SetVisible(const Value: Bool);
property OnEvent: TNotifyEvent read fOnEvent write fOnEvent;
protected
function GetDisplayName: String; override;
function GetCols: TJDGridCols;
function GetOwner: TComponent;
public
constructor Create(AOwner: TCollection); override;
destructor Destroy; override;
published
property Title: String read fTitle write SetTitle;
property Width: Integer read fWidth write SetWidth default 30;
property Visible: Bool read fVisible write SetVisible default True;
end;
implementation
{ TJDGridCols }
constructor TJDGridCols.Create(AOwner: TComponent);
begin
inherited Create(AOwner, TJDGridCol);
end;
destructor TJDGridCols.Destroy;
begin
inherited Destroy;
end;
function TJDGridCols.Add: TJDGridCol;
begin
Result := TJDGridCol(inherited Add);
DoEvent;
end;
procedure TJDGridCols.Assign(Source: TPersistent);
begin
inherited Assign(Source);
DoEvent;
end;
procedure TJDGridCols.Clear;
begin
inherited Clear;
DoEvent;
end;
procedure TJDGridCols.Delete(Index: Integer);
begin
inherited Delete(Index);
DoEvent;
end;
function TJDGridCols.GetItem(Index: Integer): TJDGridCol;
begin
Result:= TJDGridCol(inherited Items[Index]);
end;
procedure TJDGridCols.SetItem(Index: Integer; Value: TJDGridCol);
begin
inherited SetItems(Index, Value);
DoEvent;
end;
procedure TJDGridCols.DoEvent;
begin
if Assigned(fOnEvent) then fOnEvent(Self);
end;
{ TJDGridCol }
constructor TJDGridCol.Create(AOwner: TCollection);
begin
inherited Create(AOwner);
fTitle := 'Column ' + IntToStr(ID);
fWidth := 30;
fVisible := True;
end;
destructor TJDGridCol.Destroy;
begin
inherited Destroy;
end;
procedure TJDGridCol.DoEvent;
begin
if Assigned(fOnEvent) then fOnEvent(Self);
end;
function TJDGridCol.GetDisplayName: String;
begin
Result := fTitle;
end;
function TJDGridCol.GetCols: TJDGridCols;
begin
Result := Collection as TJDGridCols;
end;
function TJDGridCol.GetOwner: TComponent;
begin
Result := GetCols.GetOwner as TComponent;
end;
procedure TJDGridCol.SetTitle(const Value: String);
begin
if fTitle <> Value then
begin
fTitle := Value;
DoEvent;
end;
end;
procedure TJDGridCol.SetVisible(const Value: Bool);
begin
if fVisible <> Value then
begin
fVisible := Value;
DoEvent;
end;
end;
procedure TJDGridCol.SetWidth(const Value: Integer);
begin
if fWidth <> Value then
begin
fWidth := Value;
DoEvent;
end;
end;
end.

Resources