Persistent Polymorphic Lists in Delphi - delphi

Question

I need a list of polymorphic objects (different object classes, but with a common base class) that I can 'persist' as part of a form file.
TList isn't persistent, and TCollection isn't polymorphic.
I can probably roll my own but prefer not to reinvent the wheel. Ideas?

Answer 1

None of the standard library classes meet you needs. You need to roll your own, or find a third party library.

Answer 2

For using default streaming framework you have to create wrapper collection item that can hold and create object instances of different classes.
unit PolyU;
interface
uses
System.SysUtils,
System.Classes;
type
TWrapperItem = class(TCollectionItem)
protected
FObjClassName: string;
FObjClass: TPersistentClass;
FObj: TPersistent;
procedure SetObjClass(Value: TPersistentClass);
procedure SetObjClassName(Value: string);
procedure SetObj(Value: TPersistent);
function CreateObject(OClass: TPersistentClass): Boolean; dynamic;
public
property ObjClass: TPersistentClass read FObjClass write SetObjClass;
published
// ObjClassName must be published before Obj to trigger CreateObject
property ObjClassName: string read FObjClassName write SetObjClassName;
property Obj: TPersistent read FObj write SetObj;
end;
implementation
procedure TWrapperItem.SetObjClass(Value: TPersistentClass);
begin
if Value <> FObjClass then
begin
FObj := nil;
FObjClass := Value;
if Value = nil then FObjClassName := ''
else FObjClassName := Value.ClassName;
CreateObject(FObjClass);
end;
end;
procedure TWrapperItem.SetObjClassName(Value: string);
begin
if Value <> FObjClassName then
begin
FObj := nil;
FObjClassName := Value;
if Value = '' then FObjClass := nil
else FObjClass := FindClass(Value);
CreateObject(FObjClass);
end;
end;
procedure TWrapperItem.SetObj(Value: TPersistent);
begin
FObj := Value;
if Assigned(Value) then
begin
FObjClassName := Value.ClassName;
FObjClass := TPersistentClass(Value.ClassType);
end
else
begin
FObjClassName := '';
FObjClass := nil;
end;
end;
function TWrapperItem.CreateObject(OClass: TPersistentClass): Boolean;
begin
Result := false;
if OClass = nil then exit;
try
FreeAndNil(FObj);
if OClass.InheritsFrom(TCollectionItem) then FObj := TCollectionItem(TCollectionItemClass(OClass).Create(nil))
else
if OClass.InheritsFrom(TComponent) then FObj := TComponentClass(OClass).Create(nil)
else
if OClass.InheritsFrom(TPersistent) then FObj := TPersistentClass(OClass).Create;
Result := true;
except
end;
end;
end.
Classes that are going to be wrapped by TWrapperItem have to be registered with Delphi streaming system via RegisterClass or RegisterClasses methods.
Following test component contains base collection that can be edited and streamed through IDE. For more control it is possible that you may want to write custom IDE editors, but this is base to start from.
unit Unit1;
interface
uses
System.Classes,
PolyU;
type
TFoo = class(TPersistent)
protected
FFoo: string;
published
property Foo: string read FFoo write FFoo;
end;
TBar = class(TPersistent)
protected
FBar: integer;
published
property Bar: integer read FBar write FBar;
end;
TTestComponent = class(TComponent)
protected
FList: TOwnedCollection;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property List: TOwnedCollection read FList write FList;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Test', [TTestComponent]);
end;
constructor TTestComponent.Create(AOwner: TComponent);
begin
inherited;
FList := TOwnedCollection.Create(Self, TWrapperItem);
end;
destructor TTestComponent.Destroy;
begin
Flist.Free;
inherited;
end;
initialization
RegisterClasses([TFoo, TBar]);
finalization
UnRegisterClasses([TFoo, TBar]);
end.
This is how streamed TTestComponent (as part of Form) can look like:
object TestComponent1: TTestComponent
List = <
item
ObjClassName = 'TFoo'
Obj.Foo = 'abc'
end
item
ObjClassName = 'TBar'
Obj.Bar = 5
end>
Left = 288
Top = 16
end

Answer 3

I am not sure why a TCollection can not hold TCats and TDogs ?
TAnimal = class(TCollectionItem)
end;
TCat = class(TAnimal)
end;
TDog = class(TAnimal)
end;
FCollection : TCollection;
FCollection := TCollection.Create(TAnimal);
cat : TCat
cat := TCat.Create(FCollection);
dog : TDog
dog := TDag.Create(FCollection);
var
i : integer;
begin
for I := 0 to FCollection.Count - 1 do
TAnimal(FCollection.Items[i]).DoSomething;
end;
FCollection will now hold 2 items, a cat and a dog
Or I am missing the point here ?