From 7f60e77e98d13278ff2d931a768a941aa3d9171d Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 22 Jul 2006 08:59:21 +0000 Subject: [PATCH] fixed range check, added widestring stream example git-svn-id: trunk@9659 - --- .gitattributes | 5 + examples/widestringstreaming/mainunit.lfm | 115 +++++++++ examples/widestringstreaming/mainunit.lrs | 41 +++ examples/widestringstreaming/mainunit.pas | 244 ++++++++++++++++++ .../widestringstreaming.lpi | 63 +++++ .../widestringstreaming.lpr | 18 ++ lcl/lresources.pp | 1 + 7 files changed, 487 insertions(+) create mode 100644 examples/widestringstreaming/mainunit.lfm create mode 100644 examples/widestringstreaming/mainunit.lrs create mode 100644 examples/widestringstreaming/mainunit.pas create mode 100644 examples/widestringstreaming/widestringstreaming.lpi create mode 100644 examples/widestringstreaming/widestringstreaming.lpr diff --git a/.gitattributes b/.gitattributes index 8195c155dd..6a54423dcc 100644 --- a/.gitattributes +++ b/.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 diff --git a/examples/widestringstreaming/mainunit.lfm b/examples/widestringstreaming/mainunit.lfm new file mode 100644 index 0000000000..55561fffd2 --- /dev/null +++ b/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 diff --git a/examples/widestringstreaming/mainunit.lrs b/examples/widestringstreaming/mainunit.lrs new file mode 100644 index 0000000000..3e9745d87b --- /dev/null +++ b/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 +]); diff --git a/examples/widestringstreaming/mainunit.pas b/examples/widestringstreaming/mainunit.pas new file mode 100644 index 0000000000..23e70cb0e5 --- /dev/null +++ b/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. + diff --git a/examples/widestringstreaming/widestringstreaming.lpi b/examples/widestringstreaming/widestringstreaming.lpi new file mode 100644 index 0000000000..aa8a71bd14 --- /dev/null +++ b/examples/widestringstreaming/widestringstreaming.lpi @@ -0,0 +1,63 @@ + + + + + + + + + + + + </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> diff --git a/examples/widestringstreaming/widestringstreaming.lpr b/examples/widestringstreaming/widestringstreaming.lpr new file mode 100644 index 0000000000..eaca8bb298 --- /dev/null +++ b/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. + diff --git a/lcl/lresources.pp b/lcl/lresources.pp index 320650682f..9d05297a38 100644 --- a/lcl/lresources.pp +++ b/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}