Question

我需要一个多态对象列表（不同的对象类，但有一个共同的基类），我可以“持久”作为表单文件的一部分。

TList不是持久性的，并且TCollection不是多态的。

我可以自己动手但不想重新发明轮子。想法？

Answer 1

没有一个标准库类满足您的需求。您需要自己动手，或找到第三方库。

Answer 2

对于使用默认流式传输框架，您必须创建可以保存和创建不同类的对象实例的包装器集合项。

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包装的类必须通过RegisterClass或RegisterClasses方法在Delphi流媒体系统中注册。

以下测试组件包含可以通过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 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件物品，一只猫和一只狗

或者我错过了这里的观点？

Delphi中的持久多态列表

3 个答案: