Стойкие полиморфные списки в Delphi

Question

Мне нужен список полиморфных объектов (разные классы объектов, но с общим базовым классом), которые я могу «сохранить» как часть файла формы.

TList не является постоянным, а TCollection не является полиморфным.

Я, вероятно, могу опрокинуться, но предпочитаю не изобретать велосипед. Идеи?

Answer 1

Ни один из стандартных классов библиотеки не соответствует вашим потребностям. Вам нужно сворачивать самостоятельно или найти стороннюю библиотеку.

Answer 2

Я не уверен, почему TCollection не может удерживать TCats и 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 теперь будет держать 2 вещи, кот и собака

Или я пропускаю пункт здесь?

Answer 3

Для использования инфраструктуры потоковой передачи по умолчанию вы должны создать элемент коллекции оберток, который может хранить и создавать экземпляры объектов разных классов.

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. 

Классов, которые собираются быть обернут TWrapperItem должны быть зарегистрированы в системе потоковой передачи Delphi через RegisterClass или RegisterClasses методов.

Следующий тестовый компонент содержит базовую коллекцию, которую можно редактировать и передавать через среду IDE. Для большего контроля возможно, что вы захотите написать собственные редакторы IDE, но это основа для начала.

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. 

Это как в потоковом TTestComponent (как часть формы) может выглядеть следующим образом:

object TestComponent1: TTestComponent 
    List = < 
     item 
     ObjClassName = 'TFoo' 
     Obj.Foo = 'abc' 
     end 
     item 
     ObjClassName = 'TBar' 
     Obj.Bar = 5 
     end> 
    Left = 288 
    Top = 16 
    end