德爾福中的持久性多態性列表

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