如何使用readComponent()从子对象反序列化字段

时间:2016-07-18 01:20:45

标签: delphi

我正在使用writeComponent()来序列化对象和子对象。这似乎没有任何问题。在下面的示例中,我序列化了TConfigData的对象和TFoo的子对象:

object TConfigData
  myInteger = 999
  object TFoo
    value = 777
  end
end

但是当我尝试重新读取它时,readCompontent仅恢复根对象中的值myInteger,它无法恢复它设置为零的子对象TFoo中的值。我附上下面的全部代码。两个主要类是TConfigData,在那个TFoo中。我已经对互联网进行了广泛的搜索,但我无法理解为什么它没有读取TFoo.value。

有关如何让阅读工作的任何建议? (使用XE6)。我确信有一个简单的解释,但它暂时逃避了我。

unit ufMain;

interface

uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,    
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, V     
Vcl.StdCtrls;

type
  TFoo = class (TComponent)
   private
     fValue : integer;
   published
     property value : integer read fValue write fValue;
  end;

  TConfigData = class (TComponent)
     private
       fInteger : integer;
       fFoo : TFoo;  // <- Subobject
       function ComponentToStringProc(Component: TComponent): string;
       class function StringToComponentProc(Value: string): TComponent;
     protected
       procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
      function   GetChildOwner: TComponent; override;
      published
       property myInteger : Integer read fInteger write fInteger;
       property foo : TFoo read fFoo write fFoo;
     public
       procedure save (fileName : string);
       class function  load (fileName : string) : TConfigData;
       function  getConfigStreamString : string;
       constructor Create (AOwner : TComponent); override;
       destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Uses IOUTils;

procedure TConfigData.GetChildren(Proc: TGetChildProc; Root: TComponent);
var i : Integer;
begin
  inherited GetChildren(Proc, Root);
  for i := 0 to ComponentCount - 1 do
    Proc(Components[i]);
end;

function TConfigData.GetChildOwner: TComponent;
begin
  result := Self;
end;

constructor TConfigData.Create (AOwner : TComponent);
begin
  inherited;
  fFoo := TFoo.Create (self);
  // foo.SetSubComponent (True); <- I don't want to use this because it flattens the dfm file.
end;

destructor TConfigData.Destroy;
begin
  fFoo.Free;
  inherited;
end;

function TConfigData.getConfigStreamString : string;
begin
   result := ComponentToStringProc (self);
end;

procedure TConfigData.save (fileName : string);
var configStr : string;
begin
  configStr := ComponentToStringProc (self);
  TFile.WriteAllText (fileName, configStr);
end;

class function TConfigData.load (fileName : string) : TConfigData;
var configStr : string;
begin
  configStr := TFile.ReadAllText (fileName);
  result := StringToComponentProc (configStr) as TConfigData;
end;

function TConfigData.ComponentToStringProc(Component: TComponent): string;
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result:= StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;
end;

class function TConfigData.StringToComponentProc(Value: string): TComponent;
var
  StrStream:TStringStream;
  BinStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result:= BinStream.ReadComponent(nil);
    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var config : TConfigData;
    configStr : string;
begin
  config := TConfigData.Create (nil);
  config.myInteger := 999;
  config.foo.value := 777;
  config.save('c:\\tmp\\config.dat');
  Memo1.text := config.getConfigStreamString;
end;

procedure TForm1.Button2Click(Sender: TObject);
var config : TConfigData;
begin
  config := TConfigData.load ('c:\\tmp\\config.dat');
  Memo1.Clear;
  Memo1.Lines.Add(inttostr (config.myInteger));
  Memo1.Lines.Add(inttostr(config.foo.value));
end;

initialization
 RegisterClasses([TConfigData, TFoo]);
end.

2 个答案:

答案 0 :(得分:1)

我不知道如何阅读工作,我只能解释代码有什么问题。

替换Button2处理程序
procedure TForm1.Button2Click(Sender: TObject);
var config : TConfigData;
  I: Integer;

begin
  config := TConfigData.load ('c:\temp\config.dat');
  Memo1.Clear;
  Memo1.Lines.Add(inttostr (config.myInteger));
  Memo1.Lines.Add(inttostr(config.ComponentCount));
  for I:= 0 to config.ComponentCount - 1 do
    Memo1.Lines.Add(inttostr((config.Components[I] as TFoo).value));
end;

现在很清楚幕后发生了什么。从流加载的TConfigData实例包含2个TFoo实例 - 第一个在TConfigData构造函数中创建,第二个由Delphi流系统创建,第二个是加载的按'777'值。

答案 1 :(得分:1)

处理子对象有两种不同的方法。

其中一个是SetSubComponent(true),或者首先使用TPersistent而不是TComponent。在这种情况下,TConfigData负责在其构造函数中创建子对象并在析构函数中销毁它。流媒体系统&#34;期待&#34;该组件已经存在,只需要修改其字段。

但是儿童成分以不同的方式对待。它们由流系统本身创建,属于GetChildOwner返回的组件(在您的情况下为TConfigData)。如果子组件没有名称(或者说具有空名称),则不再执行任何操作。但是,如果它有一个名称,流系统会查找同名的已发布字段,以将它们分配给新创建的组件。它在VCL中的工作原理如下:TForm1(例如)将所有控件都作为已发布的字段,这些字段指向从.dfm自动加载的控件。

在您的情况下,组件TFoo已成功加载,并且它在Components []中列出,但它与foo属性无关,这导致在{{1}中创建的空组件构造函数。

如何修复

子组件与其父组件的连接弱于子组件,预计父组件不知道它可以拥有多少子组件,这适用于大多数控件。这就是为什么在构造函数中创建子项的原因并不是预期的。如果从一开始就知道需要什么类型的子代,那么使用子组件似乎更合乎逻辑。

尽管如此,也可以使用子组件来完成。

使用已发布的字段Foo:

而不是属性Foo
TConfigData

在构造函数中,我们创建新的TFoo并为其命名:

TConfigData = class (TComponent)
     private
       fInteger : integer;
       function ComponentToStringProc(Component: TComponent): string;
       class function StringToComponentProc(Value: string): TComponent;
     protected
       procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
      function   GetChildOwner: TComponent; override;
      published
       Foo: TFoo;
       property myInteger : Integer read fInteger write fInteger;
     public
       procedure save (fileName : string);
       class function  load (fileName : string) : TConfigData;
       function  getConfigStreamString : string;
       constructor Create (AOwner : TComponent); override;
       destructor Destroy; override;
  end;

但是从文件加载时,我们会销毁所有现有组件,因为流式系统会从头开始创建它们,否则会发生名称冲突。这样的事情:

constructor TConfigData.Create (AOwner : TComponent);
begin
  inherited;
  Foo := TFoo.Create (self);
  Foo.name = 'Foo'; //looks like tautology but it's not!
end;

现在应该可以了。

也许删除构造函数class function TConfigData.StringToComponentProc(Value: string): TComponent; var StrStream:TStringStream; BinStream: TMemoryStream; begin StrStream := TStringStream.Create(Value); try BinStream := TMemoryStream.Create; try ObjectTextToBinary(StrStream, BinStream); BinStream.Seek(0, soFromBeginning); Result:= TConfigFile.Create(nil); //it creates components we don't need Result.DestroyComponents; //not any more BinStream.ReadComponent(Result); //it reads to component already created finally BinStream.Free; end; finally StrStream.Free; end; end; 更加优雅(继承就足够了)并使用另一个,例如Create(aOwner: TComponent)只能从您的代码调用,以防这个配置文件没找到。或者,而不是构造函数使用过程CreateNew或类似这样的smth,它会将所有字段设置为默认值,并在需要时创建InitializeDefault

甚至可以永远不在运行时显式创建TFoo,而是从文件或存储其默认值的资源加载TFoo