2

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

TList 不是持久的，TCollection 不是多态的。

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

4

3 回答 3

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必须通过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
于 2015-08-22T12:23:48.740 回答
3

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

于 2015-08-21T20:48:58.807 回答
0

我不确定为什么 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 件物品，一只猫和一只狗

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

于 2015-08-21T21:04:54.310 回答