fixed range check, added widestring stream example

git-svn-id: trunk@9659 -

.gitattributes

@@ -1122,6 +1122,11 @@ examples/turbopower_ipro/mainunit.pas svneol=native#text/pascal
 examples/turbopower_ipro/simplepage2.html svneol=native#text/html
 examples/turbopower_ipro/tpiproexample.lpi svneol=native#text/plain
 examples/turbopower_ipro/tpiproexample.lpr svneol=native#text/pascal
+examples/widestringstreaming/mainunit.lfm svneol=native#text/plain
+examples/widestringstreaming/mainunit.lrs svneol=native#text/plain
+examples/widestringstreaming/mainunit.pas svneol=native#text/plain
+examples/widestringstreaming/widestringstreaming.lpi svneol=native#text/plain
+examples/widestringstreaming/widestringstreaming.lpr svneol=native#text/plain
 examples/xmlstreaming/mainunit.lfm svneol=native#text/plain
 examples/xmlstreaming/mainunit.lrs svneol=native#text/plain
 examples/xmlstreaming/mainunit.pas svneol=native#text/plain

examples/widestringstreaming/mainunit.lfm

@@ -0,0 +1,115 @@
+object StreamDemoForm: TStreamDemoForm
+  Caption = 'Streaming components example'
+  ClientHeight = 485
+  ClientWidth = 525
+  OnCreate = FormCreate
+  PixelsPerInch = 112
+  HorzScrollBar.Page = 524
+  VertScrollBar.Page = 484
+  Left = 292
+  Height = 485
+  Top = 168
+  Width = 525
+  object Note1Label: TLabel
+    Caption = 'This example demonstrates, how to stream a component to a stream in binary format ...'
+    Color = clNone
+    ParentColor = False
+    WordWrap = True
+    Left = 253
+    Height = 43
+    Top = 27
+    Width = 196
+  end
+  object Note2Label: TLabel
+    Caption = '... and how to reconstruct the component from a stream. This technique can be used to save components to disk or to transfer them via network. Of course this also works for your own classes as long as they are descendants of TComponent.'
+    Color = clNone
+    ParentColor = False
+    WordWrap = True
+    Left = 265
+    Height = 103
+    Top = 325
+    Width = 228
+  end
+  object SourceGroupBox: TGroupBox
+    Caption = 'Source'
+    ClientHeight = 73
+    ClientWidth = 191
+    TabOrder = 0
+    Left = 15
+    Height = 90
+    Top = 25
+    Width = 195
+    object AGroupBox: TGroupBox
+      Caption = 'AGroupBox'
+      ClientHeight = 26
+      ClientWidth = 124
+      TabOrder = 0
+      Left = 23
+      Height = 43
+      Top = 15
+      Width = 128
+    end
+  end
+  object DestinationGroupBox: TGroupBox
+    Anchors = [akLeft, akBottom]
+    Caption = 'Destination'
+    ClientHeight = 92
+    ClientWidth = 211
+    TabOrder = 1
+    Left = 30
+    Height = 109
+    Top = 360
+    Width = 215
+  end
+  object WriteToStreamButton: TButton
+    BorderSpacing.InnerBorder = 4
+    Caption = '1. Write AGroupBox to stream'
+    OnClick = WriteToStreamButtonClick
+    TabOrder = 2
+    Left = 23
+    Height = 25
+    Top = 130
+    Width = 197
+  end
+  object StreamGroupBox: TGroupBox
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    Caption = 'Stream (special characters are shown as hexnumbers)'
+    ClientHeight = 115
+    ClientWidth = 492
+    TabOrder = 3
+    Left = 15
+    Height = 132
+    Top = 170
+    Width = 496
+    object StreamMemo: TMemo
+      Align = alClient
+      Lines.Strings = (
+        'First click on the button above, then on button below'
+      )
+      ReadOnly = True
+      TabOrder = 0
+      Height = 95
+      Width = 492
+    end
+    object StreamAsLFMCheckBox: TCheckBox
+      Align = alBottom
+      Caption = 'Show sream in LFM format (text)'
+      OnChange = StreamAsLFMCheckBoxChange
+      TabOrder = 1
+      Height = 20
+      Top = 95
+      Width = 492
+    end
+  end
+  object ReadStreamButton: TButton
+    Anchors = [akLeft, akBottom]
+    BorderSpacing.InnerBorder = 4
+    Caption = '2. Create component from stream'
+    OnClick = ReadStreamButtonClick
+    TabOrder = 4
+    Left = 25
+    Height = 24
+    Top = 316
+    Width = 215
+  end
+end

examples/widestringstreaming/mainunit.lrs

@@ -0,0 +1,41 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TStreamDemoForm','FORMDATA',[
+  'TPF0'#15'TStreamDemoForm'#14'StreamDemoForm'#7'Caption'#6#28'Streaming compo'
+  +'nents example'#12'ClientHeight'#3#229#1#11'ClientWidth'#3#13#2#8'OnCreate'#7
+  +#10'FormCreate'#13'PixelsPerInch'#2'p'#18'HorzScrollBar.Page'#3#12#2#18'Vert'
+  +'ScrollBar.Page'#3#228#1#4'Left'#3'$'#1#6'Height'#3#229#1#3'Top'#3#168#0#5'W'
+  +'idth'#3#13#2#0#6'TLabel'#10'Note1Label'#7'Caption'#6'UThis example demonstr'
+  +'ates, how to stream a component to a stream in binary format ...'#5'Color'#7
+  +#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#4'Left'#3#253#0#6'Height'#2'+'#3
+  +'Top'#2#27#5'Width'#3#196#0#0#0#6'TLabel'#10'Note2Label'#7'Caption'#6#236'..'
+  +'. and how to reconstruct the component from a stream. This technique can be'
+  +' used to save components to disk or to transfer them via network. Of course'
+  +' this also works for your own classes as long as they are descendants of TC'
+  +'omponent.'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#4'Left'#3#9
+  +#1#6'Height'#2'g'#3'Top'#3'E'#1#5'Width'#3#228#0#0#0#9'TGroupBox'#14'SourceG'
+  +'roupBox'#7'Caption'#6#6'Source'#12'ClientHeight'#2'I'#11'ClientWidth'#3#191
+  +#0#8'TabOrder'#2#0#4'Left'#2#15#6'Height'#2'Z'#3'Top'#2#25#5'Width'#3#195#0#0
+  +#9'TGroupBox'#9'AGroupBox'#7'Caption'#6#9'AGroupBox'#12'ClientHeight'#2#26#11
+  +'ClientWidth'#2'|'#8'TabOrder'#2#0#4'Left'#2#23#6'Height'#2'+'#3'Top'#2#15#5
+  +'Width'#3#128#0#0#0#0#9'TGroupBox'#19'DestinationGroupBox'#7'Anchors'#11#6'a'
+  +'kLeft'#8'akBottom'#0#7'Caption'#6#11'Destination'#12'ClientHeight'#2'\'#11
+  +'ClientWidth'#3#211#0#8'TabOrder'#2#1#4'Left'#2#30#6'Height'#2'm'#3'Top'#3'h'
+  +#1#5'Width'#3#215#0#0#0#7'TButton'#19'WriteToStreamButton'#25'BorderSpacing.'
+  +'InnerBorder'#2#4#7'Caption'#6#28'1. Write AGroupBox to stream'#7'OnClick'#7
+  +#24'WriteToStreamButtonClick'#8'TabOrder'#2#2#4'Left'#2#23#6'Height'#2#25#3
+  +'Top'#3#130#0#5'Width'#3#197#0#0#0#9'TGroupBox'#14'StreamGroupBox'#7'Anchors'
+  +#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6'3Stream (specia'
+  +'l characters are shown as hexnumbers)'#12'ClientHeight'#2's'#11'ClientWidth'
+  +#3#236#1#8'TabOrder'#2#3#4'Left'#2#15#6'Height'#3#132#0#3'Top'#3#170#0#5'Wid'
+  +'th'#3#240#1#0#5'TMemo'#10'StreamMemo'#5'Align'#7#8'alClient'#13'Lines.Strin'
+  +'gs'#1#6'5First click on the button above, then on button below'#0#8'ReadOnl'
+  +'y'#9#8'TabOrder'#2#0#6'Height'#2'_'#5'Width'#3#236#1#0#0#9'TCheckBox'#19'St'
+  +'reamAsLFMCheckBox'#5'Align'#7#8'alBottom'#7'Caption'#6#31'Show sream in LFM'
+  +' format (text)'#8'OnChange'#7#25'StreamAsLFMCheckBoxChange'#8'TabOrder'#2#1
+  +#6'Height'#2#20#3'Top'#2'_'#5'Width'#3#236#1#0#0#0#7'TButton'#16'ReadStreamB'
+  +'utton'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2
+  +#4#7'Caption'#6#31'2. Create component from stream'#7'OnClick'#7#21'ReadStre'
+  +'amButtonClick'#8'TabOrder'#2#4#4'Left'#2#25#6'Height'#2#24#3'Top'#3'<'#1#5
+  +'Width'#3#215#0#0#0#0
+]);

examples/widestringstreaming/mainunit.pas

@@ -0,0 +1,244 @@
+unit MainUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics,
+  Dialogs, StdCtrls, Buttons;
+
+type
+
+  { TMyComponent }
+
+  TMyComponent = class(TCheckBox)
+  private
+    FDefaultText: WideString;
+    FWideStr1: widestring;
+    procedure SetDefaultText(const AValue: WideString);
+    procedure SetWideStr1(const AValue: widestring);
+    function WideStr1IsStored: boolean;
+    procedure ReadText(Reader: TReader);
+    procedure WriteText(Writer: TWriter);
+  protected
+    procedure DefineProperties(Filer: TFiler); override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+  published
+    property WideStr1: widestring read FWideStr1 write SetWideStr1 stored WideStr1IsStored;
+    property DefaultText: WideString read FDefaultText write SetDefaultText stored False;
+  end;
+
+  { TStreamDemoForm }
+
+  TStreamDemoForm = 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
+  StreamDemoForm: TStreamDemoForm;
+
+implementation
+
+{ TStreamDemoForm }
+
+procedure TStreamDemoForm.WriteToStreamButtonClick(Sender: TObject);
+var
+  AStream: TMemoryStream;
+begin
+  AStream:=TMemoryStream.Create;
+  try
+    WriteComponentAsBinaryToStream(AStream,AGroupBox);
+    SaveStreamAsString(AStream);
+  finally
+    AStream.Free;
+  end;
+end;
+
+procedure TStreamDemoForm.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 TStreamDemoForm.FormCreate(Sender: TObject);
+var
+  MyComponent: TMyComponent;
+begin
+  // create a checkbox with Owner = AGroupBox
+  // because TWriter writes all components owned by AGroupBox
+  MyComponent:=TMyComponent.Create(AGroupBox);
+  with MyComponent do begin
+    Name:='MyComponent';
+    Parent:=AGroupBox;
+  end;
+end;
+
+procedure TStreamDemoForm.StreamAsLFMCheckBoxChange(Sender: TObject);
+begin
+  ShowStreamInMemo;
+end;
+
+procedure TStreamDemoForm.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 TStreamDemoForm.SaveStreamAsString(AStream: TStream);
+begin
+  StreamAsString:=ReadStringFromStream(AStream);
+  ShowStreamInMemo;
+end;
+
+procedure TStreamDemoForm.ReadStreamFromString(AStream: TStream);
+begin
+  AStream.Size:=0;
+  if StreamAsString<>'' then
+    AStream.Write(StreamAsString[1],length(StreamAsString));
+  AStream.Position:=0;
+end;
+
+function TStreamDemoForm.ReadStringFromStream(AStream: TStream): string;
+begin
+  AStream.Position:=0;
+  SetLength(Result,AStream.Size);
+  if Result<>'' then
+    AStream.Read(Result[1],length(Result));
+end;
+
+procedure TStreamDemoForm.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 (StreamDemoForm).
+  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 TStreamDemoForm.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
+  else if CompareText(AClassName,'TMyComponent')=0 then
+    ComponentClass:=TMyComponent;
+end;
+
+{ TMyComponent }
+
+procedure TMyComponent.SetWideStr1(const AValue: widestring);
+begin
+  if FWideStr1=AValue then exit;
+  FWideStr1:=AValue;
+end;
+
+procedure TMyComponent.SetDefaultText(const AValue: WideString);
+begin
+  if FDefaultText=AValue then exit;
+  FDefaultText:=AValue;
+end;
+
+function TMyComponent.WideStr1IsStored: boolean;
+begin
+  Result:=true;
+end;
+
+procedure TMyComponent.ReadText(Reader: TReader);
+begin
+  case Reader.NextValue of
+    vaLString, vaString:
+      SetDefaultText(Reader.ReadString);
+  else
+    SetDefaultText(Reader.ReadWideString);
+  end;
+end;
+
+procedure TMyComponent.WriteText(Writer: TWriter);
+begin
+  Writer.WriteWideString(FDefaultText);
+end;
+
+procedure TMyComponent.DefineProperties(Filer: TFiler);
+begin
+  inherited DefineProperties(Filer);
+  Filer.DefineProperty('WideDefaultText', @ReadText, @WriteText, FDefaultText <> 'Node');
+end;
+
+constructor TMyComponent.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FWideStr1:='';
+end;
+
+initialization
+  {$I mainunit.lrs}
+
+end.
+

examples/widestringstreaming/widestringstreaming.lpi

@@ -0,0 +1,63 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="componentstreaming"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="widestringstreaming.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="WideStringStreaming"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="mainunit.pas"/>
+        <ComponentName Value="StreamDemoForm"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="mainunit.lrs"/>
+        <UnitName Value="MainUnit"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

examples/widestringstreaming/widestringstreaming.lpr

@@ -0,0 +1,18 @@
+program WideStringStreaming;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { add your units here }, MainUnit;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TStreamDemoForm, StreamDemoForm);
+  Application.Run;
+end.
+

lcl/lresources.pp

@@ -3523,6 +3523,7 @@ end;
 
 procedure TLRSObjectWriter.WriteWideStringContent(ws: WideString);
 begin
+  if ws='' then exit;
   {$IFDEF FPC_BIG_ENDIAN}
   WriteWordsReversed(PWord(@ws[1]),length(ws));
   {$ELSE}