Board index » delphi » Re: Streaming components part II

2003-07-16 11:17:07 PM
delphi211
"Henrik Bergström" writes:
I know that it is possible to publish TPersistent fields in TPersistent
classes (just tried it out). These are streamed automatically. So why use
TComponent derived classes (in your example TComp) instead of TPersistent
derived classes?
hth,
Fabian
 

Henrik Bergstrm writes:
1) The outer class (component) has the DefineProperties method overriden as usual.
2) The write method is:
type
TWriterCast = class(TWriter); // Enabled access to protected methods.
procedure TCustomColorPicker.WriteWidgets(Writer: TWriter);
var
I: Integer;
OldAncestor: TPersistent;
begin
with TWriterCast(Writer) do
begin
OldAncestor := Ancestor;
Ancestor := nil;
try
WriteValue(vaCollection);
for I := 0 to FWidgets.Count - 1 do
begin
WriteListBegin;
WritePropName('WidgetClass');
WriteString(FWidgets[I].ClassName);
WriteProperties(FWidgets[I]);
WriteListEnd;
end;
WriteListEnd;
finally
Ancestor := OldAncestor;
end;
end;
end;
I use a collection here hence the vaCollection identification at the start. I suppose you don't need this, but I recommend that you look in Classes.pas how Borland did the streaming with other property kinds.
3) The read method is then:
type
TReaderCast = class(TReader); // Enabled access to protected methods.
procedure TCustomColorPicker.ReadWidgets(Reader: TReader);
var
I: Integer;
S: string;
Widget: TColorPickerWidget;
ClassFound: Boolean;
begin
FWidgets.Clear;
with TReaderCast(Reader) do
begin
// Skip vaCollection indicator.
ReadValue;
while not EndOfList do
begin
ReadListBegin;
// Determine class to create. Skip 'WidgetClass' property name.
ReadStr;
S := ReadString;
ClassFound := False;
for I := 0 to RegisteredWidgets.Count - 1 do
if RegisteredWidgets[I].ClassName = S then
begin
ClassFound := True;
Widget := TColorPickerWidgetClass(RegisteredWidgets[I]).Create(Self);
while not EndOfList do
ReadProperty(Widget);
FWidgets.Add(Widget);
Break;
end;
if not ClassFound then
ColorPickerError('Color picker widget class ''%s'' not found.'#13#10 +
'Is the widget unit included in the uses clause?', [S]);
ReadListEnd;
end;
ReadListEnd;
end;
end;
The result looks like:
WidgetCollection = <
item
WidgetClass = 'TColorSwatchWidget'
BoxSize = 8
CMYKProfileFile = 'EuroscaleCoated.icc'
DisplayGamma = 1.000000000000000000
Spacing = -1
SwatchFile =
'ANPA Colors.aco'
StreamedSelectedColor = ''
end
item
WidgetClass = 'TDelphiColorsCpWidget'
DisplayGamma = 1.000000000000000000
StreamedSelectedColor = ''
end
item
WidgetClass = 'TColorCompareCpWidget'
DisplayGamma = 1.000000000000000000
Options = [woHotColorAsSelected, woTrackHotColor]
StreamedSelectedColor = '(1.00, 0.74, 0.07)'
StreamedAlternativeColor = '(0.00, 0.00, 0.00)'
end>
HTH
Mike
--
www.delphi-gems.com
www.delphi-unicode.net
www.lischke-online.de
 

Hi, thanks for the reply. Unfortunately I can not get it to work correctly
beacuse of problems with text DFMs. I have created a component TCompSaver
(full source at the end as usual :) to illustrate the problem I get.
If I create a TCompSaver in code and streams it everything works fine. This
code for example works:
procedure TForm1.Button1Click(Sender: TObject);
var c,c1: TCompSaver;
ss: TStringStream;
begin
c := TCompSaver.create(nil);
c.SetArr(1,64);
ss:=TStringStream.create('');
ss.WriteComponent(c);
ss.Position:=0;
c1:=TCompSaver.create(nil);
ss.ReadComponent(c1);
showmessage(inttostr(c1.GetArr(1)));
c.free;
c1.free;
end;
However, if I install TCompSaver and places it on a form, then I no longer
can save the form. When I try I get a "Error reading CompSaver1.ExtraData:
49".
Looking a bit deeper into it I have found that the problem occures when I'm
trying to save a form with "Text DFM" set, OR whenever I try to view the
form as text. Apparently ObjectBinaryToText (or which one it is that is used
here) doesn't quite like the way the properties are stored.
If I remove the call to WriteProperties (and the corresponding part in the
read method) everything works.
Here is the code for TCompSaver if anyone wants to try it out:
unit CompSaver;
interface
uses
SysUtils, Classes;
type
TReaderCast = class(TReader);
TWriterCast = class(TWriter);
TComp = class(TComponent)
private
FP1: integer;
FP2: string;
protected
public
published
property p1: integer read FP1 write FP1;
property p2: string read FP2 write FP2;
constructor create(AOwner: TComponent); override;
end;
TCompSaver = class(TComponent)
private
arr: array[1..3] of TComp;
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadData(Reader: TReader);
procedure WriteData(Writer: TWriter);
public
{ Public declarations }
constructor create(AOwner: TComponent); override;
destructor destroy; override;
procedure SetArr(index: integer; value: integer);
function GetArr(index: integer): integer;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('HB', [TCompSaver]);
end;
{ TComp }
constructor TComp.create(AOwner: TComponent);
begin
inherited;
p1 := 10;
p2 := 'Hello';
end;
{ TCompSaver }
constructor TCompSaver.create(AOwner: TComponent);
var n: integer;
begin
inherited;
for n := 1 to 3 do begin
arr[n] := TComp.create(nil);
end;
end;
procedure TCompSaver.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('ExtraData', ReadData, WriteData, true);
end;
destructor TCompSaver.destroy;
var n: integer;
begin
for n := 1 to 3 do begin
arr[n].Free;
end;
inherited;
end;
function TCompSaver.GetArr(index: integer): integer;
begin
result := arr[index].p1;
end;
procedure TCompSaver.ReadData(Reader: TReader);
var n: integer;
begin
for n := 1 to 3 do begin
arr[n].free;
arr[n] := nil;
end;
with TReaderCast(reader) do begin
reader.ReadListBegin;
n := 1;
while not reader.EndOfList do begin
reader.ReadListBegin;
arr[n] := TComp.create(nil);
while not EndOfList do
ReadProperty(arr[n]);
n := n + 1;
reader.ReadListEnd;
end;
reader.ReadListEnd;
end;
end;
procedure TCompSaver.SetArr(index, value: integer);
begin
arr[index].p1 := value;
end;
procedure TCompSaver.WriteData(Writer: TWriter);
var n: integer;
oldancestor: TPersistent;
begin
with TWriterCast(Writer) do begin
oldancestor := ancestor;
try
ancestor := nil;
writer.WriteListBegin;
for n := 1 to 3 do begin
writer.WriteListBegin;
WriteProperties(arr[n]);
writer.WriteListEnd;
end;
writer.WriteListEnd;
finally
ancestor := oldancestor;
end;
end;
end;
end.