虽然我同意 David 的观点，现在 JSON 将是持久化业务对象和容器的有效选择，但我想在此处发布使用 TCollection 和 TCollectionItem 执行此操作的代码。这是 Delphi 一直以来使用的旧方法，将组件属性流式传输到 dfm 文件。
但这里有一个警告。我已经测试过这段代码，但它不起作用……不是因为它坏了（我多年来一直使用类似的代码来持久化业务对象），而是因为 TSphere 不支持 TPersistent Assign 和 AssignTo 接口。为此，集合项的属性必须是简单的数据类型和记录，或者是适当的 TPersistent 实现。而 TSphere 不是这些。
不管怎样，代码如下：
界面
Type
TNode = Class(TCollectionItem)
Private
FSphere : TSphere;
FID : String;
FNodeType : String;
FTotalDistance: integer;
Procedure SetSphere(Const Value: TSphere);
Public
Constructor Create(Collection: TCollection); Override;
Destructor Destroy; Override;
Procedure Assign(Source: TPersistent); Override;
Published
Property Sphere : TSphere Read FSphere Write SetSphere;
Property ID : String Read FID Write FID;
Property NodeType : String Read FNodeType Write FNodeType;
Property TotalDistance: integer Read FTotalDistance Write FTotalDistance; // used in Dijkstras algorithm
End;
Type
TNodes = Class(TCollection)
Private
Function GetItem(Index: integer): TNode;
Procedure SetItem(Index: integer; Value: TNode);
Public
Constructor Create; Reintroduce;
Function Add: TNode;
Procedure LoadFromFile(Const Filename: String);
Procedure LoadFromStream(S: TStream);
Procedure SaveToFile(Const Filename: String);
Procedure SaveToStream(S: TStream);
Property Items[Index: integer]: TNode Read GetItem Write SetItem; Default;
End;
Type
TNodesWrapper = Class(TComponent)
Private
FCollection: TNodes;
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Published
Property Collection: TNodes Read FCollection Write FCollection;
End;
和实施
{ TNode }
Procedure TNode.Assign(Source: TPersistent);
Begin
If Source Is TNode Then Begin
If Assigned(Collection) Then
Collection.BeginUpdate;
Try
Sphere := TNode(Source).Sphere;
ID := TNode(Source).ID;
NodeType := TNode(Source).NodeType;
TotalDistance := TNode(Source).TotalDistance;
Finally
If Assigned(Collection) Then
Collection.EndUpdate;
End;
End
Else
Inherited;
End;
Constructor TNode.Create(Collection: TCollection);
Begin
Inherited;
FSphere := TSphere.Create(Nil);
// Set default values here
End;
Destructor TNode.Destroy;
Begin
FreeAndNil(FSphere);
Inherited;
End;
Procedure TNode.SetSphere(Const Value: TSphere);
Begin
FSphere.Assign(Value);
End;
{ TNodes }
Function TNodes.Add: TNode;
Begin
Result := TNode(Inherited Add);
End;
Constructor TNodes.Create;
Begin
Inherited Create(TNode);
End;
Function TNodes.GetItem(Index: integer): TNode;
Begin
Result := TNode(Inherited GetItem(Index));
End;
Procedure TNodes.LoadFromFile(Const Filename: String);
Var
S: TFileStream;
Begin
S := TFileStream.Create(Filename, fmOpenRead);
Try
LoadFromStream(S);
Finally
S.Free;
End;
End;
Procedure TNodes.LoadFromStream(S: TStream);
Var
Wrapper: TNodesWrapper;
SBin : TMemoryStream;
Begin
SBin := TMemoryStream.Create;
Wrapper := TNodesWrapper.Create(Nil);
Try
ObjectTextToBinary(S, SBin);
SBin.Position := 0;
SBin.ReadComponent(Wrapper);
Assign(Wrapper.Collection);
Finally
Wrapper.Free;
SBin.Free;
End;
End;
Procedure TNodes.SaveToFile(Const Filename: String);
Var
S: TStream;
Begin
S := TFileStream.Create(Filename, fmCreate);
Try
SaveToStream(S);
Finally
S.Free;
End;
End;
Procedure TNodes.SaveToStream(S: TStream);
Var
Wrapper: TNodesWrapper;
SBin : TMemoryStream;
Begin
SBin := TMemoryStream.Create;
Wrapper := TNodesWrapper.Create(Nil);
Try
Wrapper.Collection.Assign(Self);
SBin.WriteComponent(Wrapper);
SBin.Position := 0;
ObjectBinaryToText(SBin, S);
Finally
Wrapper.Free;
SBin.Free;
End;
End;
Procedure TNodes.SetItem(Index: integer; Value: TNode);
Begin
Inherited SetItem(Index, Value);
End;
{ TNodesWrapper }
Constructor TNodesWrapper.Create(AOwner: TComponent);
Begin
Inherited;
FCollection := TNodes.Create;
End;
Destructor TNodesWrapper.Destroy;
Begin
FreeAndNil(FCollection);
Inherited;
End;
TCollection 仍在使用中，尽管其中一些代码对于习惯使用通用容器的人来说可能看起来很奇怪...其中大部分与类型转换和将一个 TCollectionItem 类链接到其特定的 TCollection 类有关。
奇迹发生在 Stream ReadComponent 和 WriteComponent 方法中。不幸的是，由于 TCollection 不是 TComponent，它必须包装在 TComponent 中......这就是 TNodesWrapper 的用途。
它可能看起来很奇怪和复杂，但其中大部分可以抽象为通用 TCollection 后代，它添加了加载和保存到文件/流/字符串的能力。所以大部分代码都可以隐藏在引擎盖下。
而且...我再说一遍...这仅适用于您想要持久的属性本身是可持久的...而 TSphere 不是。所以我现在想知道 FireMonkey 3D 表单是如何保持它们的，因为我还没有真正开发 3D 应用程序。