Постоянные полиморфные списки в Delphi

Question

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

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

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

Answer 1

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

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

Answer 2

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

Answer 3

Я не уверен, почему 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 предмета, кошку и собаку

Или я здесь упускаю смысл?