Bri*_*ost 2 delphi serialization tpersistent tcomponent
我对如何从具有TPersistent字段的TComponent写出属性感到非常困惑.例如,我有:
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;
Run Code Online (Sandbox Code Playgroud)
当我使用以下编写器代码时:
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;
Run Code Online (Sandbox Code Playgroud)
我只得到以下内容:
object TTest
One = 0
end
Run Code Online (Sandbox Code Playgroud)
即缺少TPersistent TChildObj.
这篇关于组件系列化的文章指出"组件将默认流式传输任何不是TComponent的TPersistent类型的属性.我们的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
Run Code Online (Sandbox Code Playgroud)
这似乎表明只有组件和子组件被序列化.如果我让TChildObj从TComponent下降(并给它一个名字),我的名字出现在书面文件中(但仍然没有属性).
我真正不理解的是TControl(一个组件)具有Font属性(TPersistent),当你编写一个TLabel时,这会得到很好的流式传输.
或者这与默认属性有关吗?
任何帮助赞赏.
Rem*_*eau 11
当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
Run Code Online (Sandbox Code Playgroud)
您的ChildObj属性是只读属性,因此它不满足PropInfo^.SetProc <> nil要求,并且它不是一个非TComponent衍生的子组件,因此它不满足is 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;
Run Code Online (Sandbox Code Playgroud)
.
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;
Run Code Online (Sandbox Code Playgroud)
如果你采取这种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;
Run Code Online (Sandbox Code Playgroud)
.
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;
Run Code Online (Sandbox Code Playgroud)