Can I serialize a Delphi TPersistent as a field of TComponent using the default WriteComponent action?

Question

I'm getting very confused about how to write out properties from a TComponent that has a TPersistent field. For example I have:

  TChildObj = class( TPersistent )
  PRIVATE
    FVisible: boolean;
    FColor: TColor;
  PUBLIC
  PUBLISHED
    property Visible : boolean
               read FVisible
               write FVisible;
    property Color : TColor
               read FColor
               write FColor;
  end;


  TTest = class( TComponent )
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
  private
    FChildObj : TChildObj;
    FOne: integer;
  published
    property One : integer
               read FOne
               write FOne;
    property ChildObj : TChildObj
               read FChildObj;
  end;

When I use the following writer code:

procedure TForm1.Button5Click(Sender: TObject);
var
  MS : TMemoryStream;
  SS : TStringStream;
  Test : TTest;
begin
  Test := TTest.Create( Self );
  MS := TMemoryStream.Create;
  SS := TStringStream.Create;
  try
    MS.WriteComponent( Test );
    MS.Position := 0;
    ObjectBinaryToText( MS, SS );
    SS.SaveToFile( 'c:\scratch\test.txt' );
  finally
    MS.Free;
    SS.Free;
  end;

end;

I get only the following:

object TTest
  One = 0
end

i.e the TPersistent TChildObj is missing.

This article on component seriealization states "A Component will stream by default any property of type TPersistent that is not a TComponent. Our TPersistent property is streamed just like a component, and it may have other TPersistent properties that will get streamed." however when I step into System.Classes, at around line 12950 (XE3) there is the test:

  if (PropInfo^.GetProc <> nil) and
     ((PropInfo^.SetProc <> nil) or
     ((PropInfo^.PropType^.Kind = tkClass) and
      (TObject(GetOrdProp(Instance, PropInfo)) is TComponent) and
      (csSubComponent in TComponent(GetOrdProp(Instance, PropInfo)).ComponentStyle))) then

which seems to indicate that only components and sub-components are serialised. If I make TChildObj descend from TComponent (and give it a name) I get its name appearing in the written file (but still no properties).

What I really dont understand is that TControl (a component) has the Font property (TPersistent) and this gets streamed out fine when you write a TLabel for example.

Or is this something to do with default properties?

Any help appreciated.

Answer 1

Look more closely at the list of requirements when the RTL is deciding if it needs to stream a TPersistent property:

if (PropInfo^.GetProc <> nil) and
 ((PropInfo^.SetProc <> nil) or
 ((PropInfo^.PropType^.Kind = tkClass) and
  (TObject(GetOrdProp(Instance, PropInfo)) is TComponent) and
  (csSubComponent in TComponent(GetOrdProp(Instance, PropInfo)).ComponentStyle))) then

Your ChildObj property is a read-only property, so it does not satisfy the PropInfo^.SetProc <> nil requirement, and it is not a TComponent-derived sub-component, so it does not satisfy the is is TComponent and csSubComponent requirements. That is why your property is missing from the DFM.

The simpliest solution is to make your ChildObj property be read/write instead of read-only (don't use TComponent unless you have to, which you don't in this situation).

You are also missing a destructor in TTest to free the TChildObj object. And for good measure, you should give TChildObj an OnChange event that TTest can assign a handler to, so it can react to changes to the TChildObj sub-properties.

Try this:

type
  TChildObj = class(TPersistent)
  private
    FVisible : Boolean;
    FColor : TColor;
    FOnChange : TNotifyEvent;
    procedure Changed;
    procedure SetVisible(Value : Boolean);
    procedure SetColor(Value : TColor);
  public
    procedure Assign(Source : TPersistent); override;
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
  published
    property Visible : Boolean read FVisible write SetVisible;
    property Color : TColor read FColor write SetColor;
  end;

  TTest = class(TComponent)
  private
    FChildObj : TChildObj;
    FOne : integer;
    procedure ChildObjChanged(Sender : TObject);
    procedure SetChildObj(Value : TChildObj);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property One : integer read FOne write FOne;
    property ChildObj : TChildObj read FChildObj write SetChildObj;
  end;

.

procedure TChildObj.Assign(Source: TPersistent);
begin
  if Source is TChildObj then
  begin
    FVisible := TChildObj(Source).Visible;
    FColor := TChildObj(Source).Color;
    Changed;
  end else
    inherited;
end;

procedure TChildObj.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TChildObj.SetVisible(Value : Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed;
  end;
end;

procedure TChildObj.SetColor(Value : TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

constructor TTest.Create(AOwner : TComponent);
begin
  inherited;
  FChildObj := TChildObj.Create;
  FChildObj.OnChange := ChildObjChanged;
end;

destructor TTest.Destroy;
begin
  FChildObj.Free;
  inherited;
end;

procedure TTest.ChildObjChanged(Sender : TObject);
begin
  if csLoading in ComponentState then Exit;
  // use ChildObj values as needed...
end;

procedure TTest.Loaded;
begin
  inherited;
  ChildObjChanged(nil);
end;

procedure TTest.SetChildObj(Value : TChildObj);
begin
  if FChildObj <> Value then
    FChildObj.Assign(Value);
end;

If you go the TComponent approach, then try this instead:

type
  TChildObj = class(TComponent)
  private
    FVisible : Boolean;
    FColor : TColor;
    FOnChange : TNotifyEvent;
    procedure Changed;
    procedure SetVisible(Value : Boolean);
    procedure SetColor(Value : TColor);
  public
    procedure Assign(Source : TPersistent); override;
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
  published
    property Visible : Boolean read FVisible write SetVisible;
    property Color : TColor read FColor write SetColor;
  end;

  TTest = class(TComponent)
  private
    FChildObj : TChildObj;
    FOne : integer;
    procedure ChildObjChanged(Sender : TObject);
    procedure SetChildObj(Value : TChildObj);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner : TComponent); override;
  published
    property One : integer read FOne write FOne;
    property ChildObj : TChildObj read FChildObj write SetChildObj;
  end;

.

procedure TChildObj.Assign(Source: TPersistent);
begin
  if Source is TChildObj then
  begin
    FVisible := TChildObj(Source).Visible;
    FColor := TChildObj(Source).Color;
    Changed;
  end else
    inherited;
end;

procedure TChildObj.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TChildObj.SetVisible(Value : Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed;
  end;
end;

procedure TChildObj.SetColor(Value : TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

constructor TTest.Create(AOwner : TComponent);
begin
  inherited;
  FChildObj := TChildObj.Create(Self);
  FChildObj.SetSubComponent(True);
  FChildObj.OnChange := ChildObjChanged;
end;

procedure TTest.ChildObjChanged(Sender : TObject);
begin
  if csLoading in ComponentState then Exit;
  // use ChildObj values as needed...
end;

procedure TTest.Loaded;
begin
  inherited;
  ChildObjChanged(nil);
end;

procedure TTest.SetChildObj(Value : TChildObj);
begin
  if FChildObj <> Value then
    FChildObj.Assign(Value);
end;