1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
unit MainUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics,
Dialogs, StdCtrls, Buttons;
type
{ TCompStreamDemoForm }
TCompStreamDemoForm = class(TForm)
AGroupBox: TGroupBox;
StreamAsLFMCheckBox: TCheckBox;
Note2Label: TLabel;
Note1Label: TLabel;
ReadStreamButton: TButton;
StreamMemo: TMemo;
StreamGroupBox: TGroupBox;
WriteToStreamButton: TButton;
SourceGroupBox: TGroupBox;
DestinationGroupBox: TGroupBox;
procedure FormCreate(Sender: TObject);
procedure ReadStreamButtonClick(Sender: TObject);
procedure StreamAsLFMCheckBoxChange(Sender: TObject);
procedure WriteToStreamButtonClick(Sender: TObject);
public
StreamAsString: string;
procedure ShowStreamInMemo;
procedure SaveStreamAsString(AStream: TStream);
procedure ReadStreamFromString(AStream: TStream);
function ReadStringFromStream(AStream: TStream): string;
procedure ClearDestinationGroupBox;
procedure OnFindClass(Reader: TReader; const AClassName: string;
var ComponentClass: TComponentClass);
end;
var
CompStreamDemoForm: TCompStreamDemoForm;
implementation
{$R *.lfm}
{ TCompStreamDemoForm }
procedure TCompStreamDemoForm.WriteToStreamButtonClick(Sender: TObject);
var
AStream: TMemoryStream;
begin
AStream:=TMemoryStream.Create;
try
WriteComponentAsBinaryToStream(AStream,AGroupBox);
SaveStreamAsString(AStream);
finally
AStream.Free;
end;
end;
procedure TCompStreamDemoForm.ReadStreamButtonClick(Sender: TObject);
var
NewComponent: TComponent;
AStream: TMemoryStream;
begin
ClearDestinationGroupBox;
AStream:=TMemoryStream.Create;
try
ReadStreamFromString(AStream);
NewComponent:=nil;
ReadComponentFromBinaryStream(AStream,NewComponent,
@OnFindClass,DestinationGroupBox);
if NewComponent is TControl then
TControl(NewComponent).Parent:=DestinationGroupBox;
finally
AStream.Free;
end;
end;
procedure TCompStreamDemoForm.FormCreate(Sender: TObject);
var
ACheckBox: TCheckBox;
begin
// create a checkbox with Owner = AGroupBox
// because TWriter writes all components owned by AGroupBox
ACheckBox:=TCheckBox.Create(AGroupBox);
with ACheckBox do begin
Name:='ACheckBox';
Parent:=AGroupBox;
end;
end;
procedure TCompStreamDemoForm.StreamAsLFMCheckBoxChange(Sender: TObject);
begin
ShowStreamInMemo;
end;
procedure TCompStreamDemoForm.ShowStreamInMemo;
var
LRSStream: TMemoryStream;
LFMStream: TMemoryStream;
begin
if StreamAsLFMCheckBox.Checked then begin
// convert the stream to LFM
LRSStream:=TMemoryStream.Create;
LFMStream:=TMemoryStream.Create;
try
ReadStreamFromString(LRSStream);
LRSObjectBinaryToText(LRSStream,LFMStream);
StreamMemo.Lines.Text:=ReadStringFromStream(LFMStream);
finally
LRSStream.Free;
LFMStream.Free;
end;
end else begin
// the stream is in binary format and contains characters, that can not be
// shown in the memo. Convert all special characters to hexnumbers.
StreamMemo.Lines.Text:=DbgStr(StreamAsString);
end;
end;
procedure TCompStreamDemoForm.SaveStreamAsString(AStream: TStream);
begin
StreamAsString:=ReadStringFromStream(AStream);
ShowStreamInMemo;
end;
procedure TCompStreamDemoForm.ReadStreamFromString(AStream: TStream);
begin
AStream.Size:=0;
if StreamAsString<>'' then
AStream.Write(StreamAsString[1],length(StreamAsString));
AStream.Position:=0;
end;
function TCompStreamDemoForm.ReadStringFromStream(AStream: TStream): string;
begin
AStream.Position:=0;
SetLength(Result,AStream.Size);
if Result<>'' then
AStream.Read(Result[1],length(Result));
end;
procedure TCompStreamDemoForm.ClearDestinationGroupBox;
{ free all components owned by DestinationGroupBox
Do not confuse 'Owner' and 'Parent';
The 'Owner' of a TComponent is responsible for freeing the component.
All components owned by a component can be found in its 'Components'
property.
The 'Parent' of a TControl is the visible container. For example
DestinationGroupBox has as Parent the form (CompStreamDemoForm).
All controls with the same parent are gathered in Parent.Controls.
In this simple example the created component has as Owner and Parent the
DestinationGroupBox.
}
begin
while DestinationGroupBox.ComponentCount>0 do
DestinationGroupBox.Components[0].Free;
end;
procedure TCompStreamDemoForm.OnFindClass(Reader: TReader;
const AClassName: string; var ComponentClass: TComponentClass);
begin
if CompareText(AClassName,'TGroupBox')=0 then
ComponentClass:=TGroupBox
else if CompareText(AClassName,'TCheckBox')=0 then
ComponentClass:=TCheckBox;
end;
end.
|
