From 509e8de76c811f1ad7825346ba2e29a1bc299676 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 23 Feb 2006 14:57:19 +0000 Subject: [PATCH] added example how to stream components git-svn-id: trunk@8810 - --- .gitattributes | 5 + .../componentstreaming/componentstreaming.lpi | 64 +++++++ .../componentstreaming/componentstreaming.lpr | 18 ++ examples/componentstreaming/mainunit.lfm | 115 ++++++++++++ examples/componentstreaming/mainunit.lrs | 41 ++++ examples/componentstreaming/mainunit.pas | 176 ++++++++++++++++++ lcl/lresources.pp | 49 +++++ 7 files changed, 468 insertions(+) create mode 100644 examples/componentstreaming/componentstreaming.lpi create mode 100644 examples/componentstreaming/componentstreaming.lpr create mode 100644 examples/componentstreaming/mainunit.lfm create mode 100644 examples/componentstreaming/mainunit.lrs create mode 100644 examples/componentstreaming/mainunit.pas diff --git a/.gitattributes b/.gitattributes index 2fb09b3815..f061074e00 100644 --- a/.gitattributes +++ b/.gitattributes @@ -810,6 +810,11 @@ examples/combobox.lpi svneol=native#text/plain examples/combobox.pp svneol=native#text/pascal examples/comdialogs.lpi svneol=native#text/plain examples/comdialogs.pp svneol=native#text/pascal +examples/componentstreaming/componentstreaming.lpi svneol=native#text/plain +examples/componentstreaming/componentstreaming.lpr svneol=native#text/plain +examples/componentstreaming/mainunit.lfm svneol=native#text/plain +examples/componentstreaming/mainunit.lrs svneol=native#text/plain +examples/componentstreaming/mainunit.pas svneol=native#text/plain examples/dlgform.pp svneol=native#text/pascal examples/easter/about.lfm svneol=native#text/plain examples/easter/about.lrs svneol=native#text/pascal diff --git a/examples/componentstreaming/componentstreaming.lpi b/examples/componentstreaming/componentstreaming.lpi new file mode 100644 index 0000000000..1c11ee36f2 --- /dev/null +++ b/examples/componentstreaming/componentstreaming.lpi @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/componentstreaming/componentstreaming.lpr b/examples/componentstreaming/componentstreaming.lpr new file mode 100644 index 0000000000..1cc0b4b70c --- /dev/null +++ b/examples/componentstreaming/componentstreaming.lpr @@ -0,0 +1,18 @@ +program ComponentStreaming; + +{$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(TCompStreamDemoForm, CompStreamDemoForm); + Application.Run; +end. + diff --git a/examples/componentstreaming/mainunit.lfm b/examples/componentstreaming/mainunit.lfm new file mode 100644 index 0000000000..03a8bb8212 --- /dev/null +++ b/examples/componentstreaming/mainunit.lfm @@ -0,0 +1,115 @@ +object CompStreamDemoForm: TCompStreamDemoForm + 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 = 133 + Top = 27 + Width = 217 + 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 = 2 + 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 = 91 + Width = 492 + end + object StreamAsLFMCheckBox: TCheckBox + Align = alBottom + Caption = 'Show sream in LFM format (text)' + OnChange = StreamAsLFMCheckBoxChange + TabOrder = 1 + Height = 24 + Top = 91 + Width = 492 + end + end + object ReadStreamButton: TButton + Anchors = [akLeft, akBottom] + BorderSpacing.InnerBorder = 2 + Caption = '2. Create component from stream' + OnClick = ReadStreamButtonClick + TabOrder = 4 + Left = 25 + Height = 24 + Top = 316 + Width = 215 + end +end diff --git a/examples/componentstreaming/mainunit.lrs b/examples/componentstreaming/mainunit.lrs new file mode 100644 index 0000000000..75341c6e93 --- /dev/null +++ b/examples/componentstreaming/mainunit.lrs @@ -0,0 +1,41 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TCompStreamDemoForm','FORMDATA',[ + 'TPF0'#19'TCompStreamDemoForm'#18'CompStreamDemoForm'#7'Caption'#6#28'Streami' + +'ng components example'#12'ClientHeight'#3#229#1#11'ClientWidth'#3#13#2#8'On' + +'Create'#7#10'FormCreate'#13'PixelsPerInch'#2'p'#18'HorzScrollBar.Page'#3#12 + +#2#18'VertScrollBar.Page'#3#228#1#4'Left'#3'$'#1#6'Height'#3#229#1#3'Top'#3 + +#168#0#5'Width'#3#13#2#0#6'TLabel'#10'Note1Label'#7'Caption'#6'UThis example' + +' demonstrates, 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' + +#3#133#0#3'Top'#2#27#5'Width'#3#217#0#0#0#6'TLabel'#10'Note2Label'#7'Caption' + +#6#236'... and how to reconstruct the component from a stream. This techniqu' + +'e can be used to save components to disk or to transfer them via network. O' + +'f course this also works for your own classes as long as they are descendan' + +'ts of TComponent.'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9#4'L' + +'eft'#3#9#1#6'Height'#2'g'#3'Top'#3'E'#1#5'Width'#3#228#0#0#0#9'TGroupBox'#14 + +'SourceGroupBox'#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'akLeft'#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'To' + +'p'#3'h'#1#5'Width'#3#215#0#0#0#7'TButton'#19'WriteToStreamButton'#25'Border' + +'Spacing.InnerBorder'#2#2#7'Caption'#6#28'1. Write AGroupBox to stream'#7'On' + +'Click'#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'3Strea' + +'m (special characters are shown as hexnumbers)'#12'ClientHeight'#2's'#11'Cl' + +'ientWidth'#3#236#1#8'TabOrder'#2#3#4'Left'#2#15#6'Height'#3#132#0#3'Top'#3 + +#170#0#5'Width'#3#240#1#0#5'TMemo'#10'StreamMemo'#5'Align'#7#8'alClient'#13 + +'Lines.Strings'#1#6'5First click on the button above, then on button below'#0 + +#8'ReadOnly'#9#8'TabOrder'#2#0#6'Height'#2'['#5'Width'#3#236#1#0#0#9'TCheckB' + +'ox'#19'StreamAsLFMCheckBox'#5'Align'#7#8'alBottom'#7'Caption'#6#31'Show sre' + +'am in LFM format (text)'#8'OnChange'#7#25'StreamAsLFMCheckBoxChange'#8'TabO' + +'rder'#2#1#6'Height'#2#24#3'Top'#2'['#5'Width'#3#236#1#0#0#0#7'TButton'#16'R' + +'eadStreamButton'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.Inn' + +'erBorder'#2#2#7'Caption'#6#31'2. Create component from stream'#7'OnClick'#7 + +#21'ReadStreamButtonClick'#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/componentstreaming/mainunit.pas b/examples/componentstreaming/mainunit.pas new file mode 100644 index 0000000000..944e7249ff --- /dev/null +++ b/examples/componentstreaming/mainunit.pas @@ -0,0 +1,176 @@ +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 + +{ 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 the 'Components' + property. + The 'Parent' of a TControl is the visible container. For example + DestinationGroupBox has as Parent the form. + 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; + +initialization + {$I mainunit.lrs} + +end. + diff --git a/lcl/lresources.pp b/lcl/lresources.pp index 70d885e69b..954c27896c 100644 --- a/lcl/lresources.pp +++ b/lcl/lresources.pp @@ -231,6 +231,10 @@ function CreateLRSWriter(s: TStream; var DestroyDriver: boolean): TWriter; function GetClassNameFromLRSStream(s: TStream; out IsInherited: Boolean): shortstring; procedure WriteComponentAsBinaryToStream(AStream: TStream; AComponent: TComponent); +procedure ReadComponentFromBinaryStream(AStream: TStream; + var RootComponent: TComponent; + OnFindComponentClass: TFindComponentClassEvent; + TheOwner: TComponent = nil); procedure BinaryToLazarusResourceCode(BinStream, ResStream: TStream; const ResourceName, ResourceType: String); @@ -369,6 +373,51 @@ begin end; end; +procedure ReadComponentFromBinaryStream(AStream: TStream; + var RootComponent: TComponent; + OnFindComponentClass: TFindComponentClassEvent; TheOwner: TComponent); +var + DestroyDriver: Boolean; + Reader: TReader; + IsInherited: Boolean; + AClassName: String; + AClass: TComponentClass; +begin + // get root class + AClassName:=GetClassNameFromLRSStream(AStream,IsInherited); + AClass:=nil; + OnFindComponentClass(nil,AClassName,AClass); + if AClass=nil then + raise EClassNotFound.CreateFmt('Class "%s" not found', [AClassName]); + + if RootComponent=nil then begin + // create root component + // first create the new instance and set the variable ... + RootComponent:=AClass.NewInstance as TComponent; + // then call the constructor + RootComponent.Create(TheOwner); + end else begin + // there is a root component, check if class is compatible + if not RootComponent.InheritsFrom(AClass) then begin + raise EComponentError.CreateFmt('Cannot assign a %s to a %s.', + [AClassName,RootComponent.ClassName]); + end; + end; + + // read the root component + DestroyDriver:=false; + Reader:=nil; + try + Reader:=CreateLRSReader(AStream,DestroyDriver); + Reader.OnFindComponentClass:=OnFindComponentClass; + Reader.ReadRootComponent(RootComponent); + finally + if DestroyDriver then + Reader.Driver.Free; + Reader.Free; + end; +end; + procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream; const ResourceName, ResourceType: String); { example ResStream: