德尔福中的持久性多态性列表

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包裹必须通过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