强制要在WriteComponent()中写入Real的默认值

az0*_*z01 2 delphi serialization delphi-2007

在使用默认内置"组件流系统"的特定方式中,我发现如果属性的值等于默认值,则不会写入属性的值.

我们考虑以下方案:

您使用WriteComponent()ReadComponent()来保存组件的特定状态.我们将此状态称为预设.该组件包含具有setter的各种Real类型属性.

我们知道如果属性等于其默认值,则预设将不包括该值.

所以我们的组件

  1. 我们将属性AFLoat设置为0.0
  2. 我们将预设保存在流中(MyStream.WriteComponent(MyInstance))
  3. 我们将属性AFLoat设置 为0.101
  4. 我们重新加载预设(MyStream.ReadComponent(MyInstance))

最后在重新加载预设后,AFLoat仍然等于0.101,而我们期望它的值为0.0.

错误的起源很明显,属性的默认值永远不会写在组件流中.所以在第2步:该属性没有写入,然后在第4步它不被读取...相当恼人不是它!

有没有办法强制将属性的默认值写入组件流?实际上我对Real-typed属性有一个自制的修复,但我想知道是否有一个众所周知的方法来克服这个问题.

我的自定义修复是在调用ReadComponent ()之前使用TypInfos将Real-typed属性重置为0

Procedure ResetFloatToNull(Const AnObject: TObject; Recursive: Boolean);
Var
  i,j: Integer;
  LList: PPropList;
Begin
  j := GetPropList( AnObject, LList);
  If j > 0 Then For i:= 0 To j-1 Do
    Case LList^[i].PropType^.Kind Of
    // floats with the object scope
    tkFloat: SetFloatProp(AnObject,LList^[i].Name,0);
    // floats with a subobject scope (IsSubComponent)
    tkClass: If Recursive Then
      ResetFloatToNull( TObject(GetOrdProp(AnObject,LList^[i])), True);
    End;
  FreeMem(LList);
End;
Run Code Online (Sandbox Code Playgroud)

但如果不存在其他方法,那么(隐含和次要问题):EMB不应该放弃默认值吗?虽然它对IDE对象检查器(重置为继承,在上下文菜单中)有点兴趣,但它完全导致组件序列化系统中的各种烦恼......

我希望你得到基本的问题,否则我可以添加一个小例子......


小错误的演示(在DH和评论之战的第一个答案之后添加):

program Project1;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  classes;

type
  TTestClass = class(TComponent)
  private
    ffloat1,ffloat2: single;
  published
    property float1: single read ffloat1 write ffloat1;
    property float2: single read ffloat2 write ffloat2;
  end;

var
  str: TMemoryStream;
  testclass: TTestClass;

begin
  testclass := TTestClass.Create(Nil);
  str := TMemoryStream.Create;
  //
  testclass.float1 := 0.31;
  testclass.float2 := 0.32;
  //
  testclass.float1 := 0.0;
  testclass.float2 := 0.2;
  str.WriteComponent(testclass);
  writeln( 'we have wrote a state when the prop 1 is equal to 0.0 and prop 2 is equal to 0.2');
  //
  testclass.float1 := 0.1;
  testclass.float2 := 0.3;
  writeln( 'then we set the prop 1 to 0.1 and prop 2 to 0.3');
  writeln('');
  //
  writeln( 'we reload the state saved when the prop 1 was equal to 0.0 and prop 2 to 0.2   and we get:');
  str.Position := 0;
  str.ReadComponent(testclass);
  writeln( Format( 'prop 1 equal to %.2f', [testclass.float1]));
  writeln( Format( 'prop 2 equal to %.2f', [testclass.float2]));
  //
  writeln('');
  writeln('prop 1 has not been restored because the default value 0.0 was not written');
  writeln('prop 2 has been restored because a non default value was written and read');
  //
  ReadLn;
  str.free;
  testclass.free;
end.
Run Code Online (Sandbox Code Playgroud)

Dav*_*nan 5

事实证明我对这个问题感到困惑.事实上,默认属性在这里不相关,因为实值属性不能具有默认值.

事实上,如果框架的值为0,则框架不会流出实值属性.这意味着实际值属性实际上具有硬编码默认值0.这似乎是流式框架中的一个可怕的设计缺陷.

想象一下真正有价值的属性,它1在组件的构造函数中赋值.这使得不可能为属性分配值,0并使该值在通过.dfm文件的往返过程中保持不变.

有一种解决方法,但你需要覆盖 DefineProperties

type
  TMyComponent = class(TComponent)
  private
    FValue: Double;
    procedure WriteValue(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Value: Double read FValue write FValue;
  end;

constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited;
  FValue := 1.0;
end;

procedure TMyComponent.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('Value', nil, WriteValue, True);
end;

procedure TMyComponent.WriteValue(Writer: TWriter);
begin
  Writer.WriteDouble(FValue);
end;
Run Code Online (Sandbox Code Playgroud)

VCL错误可在Classes单位中找到IsDefaultPropertyValue.这个函数里面是这个本地函数:

function IsDefaultFloatProp: Boolean;
var
  Value: Extended;
begin
  Value := GetFloatProp(Instance, PropInfo);
  if AncestorValid then
    Result := Value = GetFloatProp(Ancestor, PropInfo)
  else
    Result := Value = 0;
end;
Run Code Online (Sandbox Code Playgroud)

显然,这个功能应该像这样实现:

function IsDefaultFloatProp: Boolean;
var
  Value: Extended;
begin
  Value := GetFloatProp(Instance, PropInfo);
  if AncestorValid then
    Result := Value = GetFloatProp(Ancestor, PropInfo)
  else
    Result := False;
end;
Run Code Online (Sandbox Code Playgroud)

同样的故障似乎也存在于处理的Int64,Variantstring性质.这是一个我认为众所周知的重大缺陷.我希望在SO,Emba论坛和一些QC报告上已经有很多关于这个主题的讨论.从那时起,它就是QC#928.由于该报告超过10年并且显得奄奄一息,我创建了QC#109194.