Могу ли я сериализовать Delphi TPersistent как поле TComponent, используя действие WriteComponent по умолчанию?

Я очень запутался в том, как выписать свойства из TComponent с полем TPersistent. Например у меня есть:

  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;

Когда я использую следующий код писателя:

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;

Я получаю только следующее:

object TTest
  One = 0
end

т.е. TPersistent TChildObj отсутствует.

В этой статье о сериализации компонентов говорится: "Компонент будет по умолчанию передавать любое свойство типа TPersistent, не являющееся TComponent. Наше свойство TPersistent потоковое, как и компонент, и может иметь другие свойства TPersistent, которые будут передаваться в потоковом режиме". однако, когда я вхожу в System.Classes, около строки 12950 (XE3) происходит тест:

  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

который, кажется, указывает, что только компоненты и подкомпоненты сериализуются. Если я заставлю TChildObj спуститься с TComponent (и дам ему имя), я получу его имя в записанном файле (но все еще без свойств).

Что я действительно не понимаю, так это то, что TControl (компонент) обладает свойством Font (TPersistent), и это прекрасно работает, когда вы пишете TLabel, например.

Или это связано со свойствами по умолчанию?

Любая помощь приветствуется.

Источник

1 ответ

Решение

Посмотрите более внимательно на список требований, когда RTL решает, нужно ли передавать поток TPersistent имущество:

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

Ваш ChildObj свойство доступно только для чтения, поэтому оно не удовлетворяет PropInfo^.SetProc <> nil требование, и это не TComponentподкомпонент, поэтому он не удовлетворяет is TComponent а также csSubComponent требования. Вот почему ваша собственность отсутствует в DFM.

Самое простое решение - сделать ваш ChildObj свойство будет доступно для чтения / записи, а не только для чтения (не используйте TComponent если вам не нужно, чего вы не делаете в этой ситуации).

Вам также не хватает деструктора в TTest освободить TChildObj объект. И для хорошей меры, вы должны дать TChildObj OnChange событие, которое TTest может назначить обработчик, чтобы он мог реагировать на изменения TChildObj суб-свойства.

Попробуй это:

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;

Если вы идете TComponent подход, затем попробуйте это вместо:

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;
Источник
Другие вопросы по тегам