/examples/widestringstreaming/mainunit.pas

  1{
  2 ***************************************************************************
  3 *                                                                         *
  4 *   This source is free software; you can redistribute it and/or modify   *
  5 *   it under the terms of the GNU General Public License as published by  *
  6 *   the Free Software Foundation; either version 2 of the License, or     *
  7 *   (at your option) any later version.                                   *
  8 *                                                                         *
  9 *   This code is distributed in the hope that it will be useful, but      *
 10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 12 *   General Public License for more details.                              *
 13 *                                                                         *
 14 *   A copy of the GNU General Public License is available on the World    *
 15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 16 *   obtain it by writing to the Free Software Foundation,                 *
 17 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 18 *                                                                         *
 19 ***************************************************************************
 20}
 21unit MainUnit;
 22
 23{$mode objfpc}{$H+}
 24
 25interface
 26
 27uses
 28  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics,
 29  Dialogs, StdCtrls, Buttons;
 30
 31type
 32
 33  { TMyComponent }
 34
 35  TMyComponent = class(TCheckBox)
 36  private
 37    FDefaultText: WideString;
 38    FInteger1: integer;
 39    FWideStr1: widestring;
 40    function Integer1IsStored: boolean;
 41    procedure SetDefaultText(const AValue: WideString);
 42    procedure SetInteger1(const AValue: integer);
 43    procedure SetWideStr1(const AValue: widestring);
 44    function WideStr1IsStored: boolean;
 45    procedure ReadText(Reader: TReader);
 46    procedure WriteText(Writer: TWriter);
 47  protected
 48    procedure DefineProperties(Filer: TFiler); override;
 49  public
 50    constructor Create(TheOwner: TComponent); override;
 51  published
 52    property WideStr1: widestring read FWideStr1 write SetWideStr1 stored WideStr1IsStored;
 53    property DefaultText: WideString read FDefaultText write SetDefaultText stored False;
 54    property Integer1: integer read FInteger1 write SetInteger1;
 55  end;
 56
 57  { TStreamDemoForm }
 58
 59  TStreamDemoForm = class(TForm)
 60    AGroupBox: TGroupBox;
 61    StreamAsLFMCheckBox: TCheckBox;
 62    Note2Label: TLabel;
 63    Note1Label: TLabel;
 64    ReadStreamButton: TButton;
 65    StreamMemo: TMemo;
 66    StreamGroupBox: TGroupBox;
 67    WriteToStreamButton: TButton;
 68    SourceGroupBox: TGroupBox;
 69    DestinationGroupBox: TGroupBox;
 70    procedure FormCreate(Sender: TObject);
 71    procedure ReadStreamButtonClick(Sender: TObject);
 72    procedure StreamAsLFMCheckBoxChange(Sender: TObject);
 73    procedure WriteToStreamButtonClick(Sender: TObject);
 74  public
 75    StreamAsString: string;
 76    procedure ShowStreamInMemo;
 77    procedure SaveStreamAsString(AStream: TStream);
 78    procedure ReadStreamFromString(AStream: TStream);
 79    function ReadStringFromStream(AStream: TStream): string;
 80    procedure ClearDestinationGroupBox;
 81    procedure OnFindClass(Reader: TReader; const AClassName: string;
 82                          var ComponentClass: TComponentClass);
 83  end;
 84
 85var
 86  StreamDemoForm: TStreamDemoForm;
 87
 88implementation
 89
 90{$R mainunit.lfm}
 91
 92{ TStreamDemoForm }
 93
 94procedure TStreamDemoForm.WriteToStreamButtonClick(Sender: TObject);
 95var
 96  AStream: TMemoryStream;
 97begin
 98  AStream:=TMemoryStream.Create;
 99  try
100    WriteComponentAsBinaryToStream(AStream,AGroupBox);
101    SaveStreamAsString(AStream);
102  finally
103    AStream.Free;
104  end;
105end;
106
107procedure TStreamDemoForm.ReadStreamButtonClick(Sender: TObject);
108var
109  NewComponent: TComponent;
110  AStream: TMemoryStream;
111begin
112  ClearDestinationGroupBox;
113
114  AStream:=TMemoryStream.Create;
115  try
116    ReadStreamFromString(AStream);
117    NewComponent:=nil;
118    ReadComponentFromBinaryStream(AStream,NewComponent,
119                                  @OnFindClass,DestinationGroupBox);
120    if NewComponent is TControl then
121      TControl(NewComponent).Parent:=DestinationGroupBox;
122  finally
123    AStream.Free;
124  end;
125end;
126
127procedure TStreamDemoForm.FormCreate(Sender: TObject);
128var
129  MyComponent: TMyComponent;
130begin
131  // create a checkbox with Owner = AGroupBox
132  // because TWriter writes all components owned by AGroupBox
133  MyComponent:=TMyComponent.Create(AGroupBox);
134  with MyComponent do begin
135    Name:='MyComponent';
136    Parent:=AGroupBox;
137  end;
138end;
139
140procedure TStreamDemoForm.StreamAsLFMCheckBoxChange(Sender: TObject);
141begin
142  ShowStreamInMemo;
143end;
144
145procedure TStreamDemoForm.ShowStreamInMemo;
146var
147  LRSStream: TMemoryStream;
148  LFMStream: TMemoryStream;
149begin
150  if StreamAsLFMCheckBox.Checked then begin
151    // convert the stream to LFM
152    LRSStream:=TMemoryStream.Create;
153    LFMStream:=TMemoryStream.Create;
154    try
155      ReadStreamFromString(LRSStream);
156      LRSObjectBinaryToText(LRSStream,LFMStream);
157      StreamMemo.Lines.Text:=ReadStringFromStream(LFMStream);
158    finally
159      LRSStream.Free;
160      LFMStream.Free;
161    end;
162  end else begin
163    // the stream is in binary format and contains characters, that can not be
164    // shown in the memo. Convert all special characters to hexnumbers.
165    StreamMemo.Lines.Text:=DbgStr(StreamAsString);
166  end;
167end;
168
169procedure TStreamDemoForm.SaveStreamAsString(AStream: TStream);
170begin
171  StreamAsString:=ReadStringFromStream(AStream);
172  ShowStreamInMemo;
173end;
174
175procedure TStreamDemoForm.ReadStreamFromString(AStream: TStream);
176begin
177  AStream.Size:=0;
178  if StreamAsString<>'' then
179    AStream.Write(StreamAsString[1],length(StreamAsString));
180  AStream.Position:=0;
181end;
182
183function TStreamDemoForm.ReadStringFromStream(AStream: TStream): string;
184begin
185  AStream.Position:=0;
186  SetLength(Result,AStream.Size);
187  if Result<>'' then
188    AStream.Read(Result[1],length(Result));
189end;
190
191procedure TStreamDemoForm.ClearDestinationGroupBox;
192{ free all components owned by DestinationGroupBox
193  Do not confuse 'Owner' and 'Parent';
194  The 'Owner' of a TComponent is responsible for freeing the component.
195  All components owned by a component can be found in its 'Components'
196  property.
197  The 'Parent' of a TControl is the visible container. For example
198  DestinationGroupBox has as Parent the form (StreamDemoForm).
199  All controls with the same parent are gathered in Parent.Controls.
200  
201  In this simple example the created component has as Owner and Parent the
202  DestinationGroupBox.
203}
204begin
205  while DestinationGroupBox.ComponentCount>0 do
206    DestinationGroupBox.Components[0].Free;
207end;
208
209procedure TStreamDemoForm.OnFindClass(Reader: TReader;
210  const AClassName: string; var ComponentClass: TComponentClass);
211begin
212  if CompareText(AClassName,'TGroupBox')=0 then
213    ComponentClass:=TGroupBox
214  else if CompareText(AClassName,'TCheckBox')=0 then
215    ComponentClass:=TCheckBox
216  else if CompareText(AClassName,'TMyComponent')=0 then
217    ComponentClass:=TMyComponent;
218end;
219
220{ TMyComponent }
221
222procedure TMyComponent.SetWideStr1(const AValue: widestring);
223begin
224  if FWideStr1=AValue then exit;
225  FWideStr1:=AValue;
226end;
227
228procedure TMyComponent.SetDefaultText(const AValue: WideString);
229begin
230  if FDefaultText=AValue then exit;
231  FDefaultText:=AValue;
232end;
233
234function TMyComponent.Integer1IsStored: boolean;
235begin
236  Result:=FInteger1=3;
237end;
238
239procedure TMyComponent.SetInteger1(const AValue: integer);
240begin
241  if FInteger1=AValue then exit;
242  FInteger1:=AValue;
243end;
244
245function TMyComponent.WideStr1IsStored: boolean;
246begin
247  Result:=WideStr1<>'Node';
248end;
249
250procedure TMyComponent.ReadText(Reader: TReader);
251begin
252  case Reader.NextValue of
253    vaLString, vaString:
254      SetDefaultText(Reader.ReadString);
255  else
256    SetDefaultText(Reader.ReadWideString);
257  end;
258end;
259
260procedure TMyComponent.WriteText(Writer: TWriter);
261begin
262  Writer.WriteWideString(FDefaultText);
263end;
264
265procedure TMyComponent.DefineProperties(Filer: TFiler);
266begin
267  inherited DefineProperties(Filer);
268  Filer.DefineProperty('WideDefaultText', @ReadText, @WriteText, FDefaultText <> 'Node');
269end;
270
271constructor TMyComponent.Create(TheOwner: TComponent);
272begin
273  inherited Create(TheOwner);
274  FWideStr1:='';
275  FInteger1:=3;
276end;
277
278end.
279