Persistent Polymorphic Lists in 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?

@DavidHeffernan: The 'Add' and 'insert' methods always create the same type of TCollectionItem, surely? — Roddy, Aug 21 '15 at 20:27
@DavidHeffernan, I'm saying they always create the class type that you pass in the constructor to the TCollection. You can't have a TCollection of TAnimals that holds both TDogs and TCats. (warning : bad OO example!) http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Classes_TCollection_Create.html — Roddy, Aug 21 '15 at 20:47
I think the question could be a little clearer in that regard. I understand polymorphism well enough. `TCollection` is polymorphic in the sense that it is not constrained at compile time to hold items of a single type. But each instance is homogeneous. An edit would improve the question, but the answer is the same. — David Heffernan, Aug 21 '15 at 20:54
You could write a different style collection mechanism like `TPolyCollection` and call `MyCollection.Add(TCat);` .. `MyCollection.Add(TDog);` where are descended from `TAnimal` which descends from `TPolyCollectionItem` and passing a `TAnimalClass` (`Class of TAnimal`). You would just have to worry about storing that in the DFM and streaming it back in. The framework of `TCollection` and `TCollectionItem` is already flexible to be able to reintroduce functions returning whatever class type you wish - it's just a matter of telling it which class type you wish to create & return.. — Jerry Dodge, Aug 22 '15 at 00:30
Why can't you use DefineProperties and a TList/array? The loading and saving isn't hard. If you want I could put together an answer with some code. — Graymatter, Aug 22 '15 at 00:36

Dalija Prasnikar · Answer 1 · 2015-08-22T12:29:19.377

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

While you may be tempted to use generics in TWrapperItem, it will not work because [Delphi streaming system doesn't recognize published properties of generic type](http://qc.embarcadero.com/wc/qcmain.aspx?d=103296) — Dalija Prasnikar, Aug 22 '15 at 12:47

score 3 · Answer 2 · answered Aug 21 '15 at 20:48

3

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

answered Aug 21 '15 at 20:48

David Heffernan

601,492
42
1,072
1,490

I think this is the answer to the question you asked. If you want library recommendations, that's off topic as I'm sure a high rep user like you knows well. – David Heffernan Aug 21 '15 at 20:54
Thanks. I was trying to avoid this ending in the murky water of shopping-list questions. I'm certainly not asking specifically for a library, but if that was the answer... – Roddy Aug 21 '15 at 21:23
I think so. To the best of my knowledge there's no collection in the standard library that can, out of the box, persist heterogeneous collections. – David Heffernan Aug 21 '15 at 21:37

GuidoG · Answer 3 · 2015-08-21T21:09:57.823

0

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 ?

edited Aug 21 '15 at 21:09

answered Aug 21 '15 at 21:04

GuidoG

11,359
6
44
79

That's what I need, but does it work? Usually you add items using `FCollection.Add` – Roddy Aug 21 '15 at 21:07
Yes, you are. Consider streaming framework. DFM files. – David Heffernan Aug 21 '15 at 21:07
have not tested it as part of a custom component, so no idea how DFM streaming wil react – GuidoG Aug 21 '15 at 21:08
Well, the question seems to be about that very thing. – David Heffernan Aug 21 '15 at 21:11
True, but it also stated that a collection cannot hold and TCat and TDog. That part I adressed in my answer. – GuidoG Aug 21 '15 at 21:12
DFM streaming works fine with TCollection. That's its purpose. – Jerry Dodge Aug 21 '15 at 21:42
+1, as this has made me go and read the source code for TCollection. I think it won't work as when the collection is streamed in, all objects become TAnimals. Similarly, assigning one collection to another will downcast all the items. – Roddy Aug 21 '15 at 21:46
@JerryDodge - not when it's used like this, it won't. – Roddy Aug 21 '15 at 21:47
I cannot understand the upvote. I guess you aren't interested in streaming after all. – David Heffernan Aug 21 '15 at 21:56
1

@David - check my comment. It's a 'wrong' answer, but it's also useful as it's made me go and learn some stuff. Not all wrong answers are useless. – Roddy Aug 21 '15 at 22:09
I missed the whole `TCat` / `TDog` part. Yes, the streaming won't work for such a scenario, because the data stored in the DFM has no idea whether it was a `TCat` or a `TDog`. It's saved as `item` nodes between `< >` tags. – Jerry Dodge Aug 22 '15 at 00:18
@Jerry That's not it. The items stream themselves. The issue is that the framework can only create members with the type passed to the collection constructor. – David Heffernan Aug 22 '15 at 07:06
@David Indeed, that was my point. How is it to know whether one of such items is either a `TCat` or a `TDog` if each one has different properties? – Jerry Dodge Aug 22 '15 at 12:56
I mean I guess you can iterate through the properties and match them up, but that seems like an unnecessary and un-guaranteed overhaul. – Jerry Dodge Aug 22 '15 at 15:38

Persistent Polymorphic Lists in Delphi

3 Answers3