paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Example for streaming

Browse Source 
git-svn-id: trunk@16713 -
This commit is contained in:
michael 2011-01-05 22:54:45 +00:00
parent 8390a18298
commit 6898dcee66
2 changed files with 365 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -2112,6 +2112,7 @@ packages/fcl-json/Makefile.fpc svneol=native#text/plain
packages/fcl-json/examples/confdemo.lpi svneol=native#text/plain
packages/fcl-json/examples/confdemo.pp svneol=native#text/plain
packages/fcl-json/examples/demoformat.pp svneol=native#text/plain
packages/fcl-json/examples/demortti.pp svneol=native#text/plain
packages/fcl-json/examples/parsedemo.lpi svneol=native#text/plain
packages/fcl-json/examples/parsedemo.pp svneol=native#text/plain
packages/fcl-json/examples/simpledemo.lpi svneol=native#text/plain

364
packages/fcl-json/examples/demortti.pp Normal file
View File

@ -0,0 +1,364 @@
program demortti;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, fpjson, fpjsonrtti, variants;
{$R *.res}
Var
JS : TJSONStreamer;
Type
{ TTestItem }
TTestItem = Class(TCollectionItem)
private
FStrProp: String;
Published
Property StrProp : String Read FStrProp Write FStrProp;
end;
{ TCollComponent }
TCollComponent = Class(TComponent)
private
FCollProp: TCollection;
Published
Property CollProp : TCollection Read FCollProp Write FCollProp;
end;
{ TCompComponent }
TCompComponent = Class(TComponent)
private
FCompProp: TComponent;
Published
Property CompProp : TComponent Read FCompProp Write FCompProp;
end;
TDice = (one,two,three,four,five,six);
TThrow = Set of TDice;
{ TEnumComponent }
TEnumComponent = Class(TComponent)
private
FDice: TDice;
Published
Property Dice : TDice Read FDice Write FDice;
end;
{ TSetComponent }
TSetComponent = Class(TComponent)
private
FThrow: TThrow;
Published
Property Throw : TThrow Read FThrow Write FThrow;
end;
{ TChildComponent }
TChildComponent = Class(TComponent)
Protected
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
end;
{ TChildComponent }
procedure TChildComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
Var
I : Integer;
begin
Writeln('Children',ComponentCount);
For I:=0 to ComponentCount-1 do
Proc(Components[i]);
end;
Procedure DumpObject(const Header : String; var O : TJSONData);
begin
Writeln(Header,' : ');
Writeln(O.FormatJSON());
writeln();
FreeAndNil(O);
JS.Options:=[];
end;
Procedure DemoObject;
Var
C : TComponent;
O : TJSONData;
begin
C:=TComponent.Create(Nil);
try
C.Name:='DemoComponent';
C.Tag:=23;
O:=JS.ObjectToJSON(C);
DumpObject('Complete component',O);
finally
FreeAndNil(C);
end;
end;
Procedure DemoComponentObject;
Var
C : TCompComponent;
O : TJSONData;
begin
C:=TCompComponent.Create(Nil);
try
C.Name:='DemoComponent';
C.Tag:=23;
C.CompProp:=TCompComponent.Create(C);
C.CompProp.Name:='SubComponent';
C.CompProp.Tag:=45;
O:=JS.ObjectToJSON(C);
DumpObject('Component-valued property',O);
TCompComponent(C.CompProp).FComponentStyle:=[csSubComponent];
O:=JS.ObjectToJSON(C);
DumpObject('Component-valued property, csSubComponent in Componentstyle',O);
TCompComponent(C.CompProp).FComponentStyle:=[];
JS.options:=[jsoComponentsInline];
O:=JS.ObjectToJSON(C);
DumpObject('Component-valued property, options:=[jsoComponentsInline] ',O);
finally
FreeAndNil(C);
end;
end;
Procedure DemoChildObject;
Var
C : TChildComponent;
O : TJSONData;
begin
C:=TChildComponent.Create(Nil);
try
C.Name:='ParentComponent';
C.Tag:=23;
With TComponent.Create(C) do
begin
Name:='Child1';
Tag:=1;
end;
With TComponent.Create(C) do
begin
Name:='Child2';
Tag:=2;
end;
O:=JS.ObjectToJSON(C);
DumpObject('Component with children, default options',O);
JS.Options:=[jsoStreamChildren];
O:=JS.ObjectToJSON(C);
DumpObject('Component with children, Options:=[jsoStreamChildren]',O);
finally
FreeAndNil(C);
end;
end;
Procedure DemoEnumObject;
Var
C : TEnumComponent;
O : TJSONData;
begin
C:=TEnumComponent.Create(Nil);
try
C.Dice:=Three;
O:=JS.ObjectToJSON(C);
DumpObject('Enumerated-typed property, default settings',O);
JS.Options:=[jsoEnumeratedAsInteger];
O:=JS.ObjectToJSON(C);
DumpObject('Enumerated-typed property, Options:=[jsoEnumeratedAsInteger];',O);
finally
FreeAndNil(C);
end;
end;
Procedure DemoSetObject;
Var
C : TSetComponent;
O : TJSONData;
begin
C:=TSetComponent.Create(Nil);
try
C.Throw:=[two,five];
O:=JS.ObjectToJSON(C);
DumpObject('set-typed property, default settings',O);
JS.Options:=[jsoSetAsString];
O:=JS.ObjectToJSON(C);
DumpObject('Set-typed property, Options:=[jsoSetAsString];',O);
JS.Options:=[jsoSetAsString,jsoSetBrackets];
O:=JS.ObjectToJSON(C);
DumpObject('Set-typed property, Options:=[jsoSetAsString,jsoSetBrackets];',O);
JS.Options:=[jsoSetEnumeratedAsInteger];
O:=JS.ObjectToJSON(C);
DumpObject('Set-typed property, Options:=[jsoSetEnumeratedAsInteger];',O);
finally
FreeAndNil(C);
end;
end;
Procedure DemoObjectAsString;
Var
C : TComponent;
begin
C:=TComponent.Create(Nil);
try
C.Name:='DemoComponent';
C.Tag:=23;
Writeln('Complete component, directly as string :');
Writeln(JS.ObjectToJSONString(C));
JS.Options:=[jsoUseFormatString];
Writeln('Complete component, directly as string (Options:=[jsoUseFormatString]):');
Writeln(JS.ObjectToJSONString(C));
JS.Options:=[];
Writeln('');
finally
FreeAndNil(C);
end;
end;
Procedure DemoStrings;
Var
S : TStrings;
O : TJSONData;
C : TComponent;
begin
S:=TStringList.Create;
try
S.Add('One');
S.Add('two');
S.Add('Three');
O:=JS.StreamTStrings(S);
DumpObject('Default TStrings',O);
O:=JS.StreamTStringsArray(S);
DumpObject('TStrings as array',O);
C:=TComponent.Create(Nil);
try
C.Name:='SubComponent';
C.Tag:=12;
S.Objects[0]:=C;
O:=JS.StreamTStringsObject(S);
DumpObject('TStrings as object',O);
Writeln('TStrings Directly as JSON string, array');
Writeln(JS.StringsToJSON(S,False));
Writeln();
Writeln('TStrings Directly as JSON string, object');
Writeln(JS.StringsToJSON(S,True));
Writeln();
O:=JS.ObjectToJSON(S);
DumpObject('Passing TStrings to ObjctToJSON',O);
JS.Options:=[jsoTstringsAsArray];
O:=JS.ObjectToJSON(S);
DumpObject('Passing TStrings to ObjctToJSON (Options:=[jsoTstringsAsArray])',O);
JS.Options:=[jsoTstringsAsObject];
O:=JS.ObjectToJSON(S);
DumpObject('Passing TStrings to ObjctToJSON (Options:=[jsoTstringsAsObject])',O);
finally
FreeAndNil(C);
end;
finally
FreeAndNil(S);
end;
end;
Procedure DemoCollection;
Var
C : TCollection;
CC : TCollComponent;
O : TJSONData;
begin
C:=TCollection.Create(TTestItem);
try
(C.Add as TTestItem).StrProp:='One';
(C.Add as TTestItem).StrProp:='Two';
(C.Add as TTestItem).StrProp:='Three';
CC:=TCollComponent.Create(Nil);
try
CC.CollProp:=C;
O:=JS.ObjectToJSON(CC);
DumpObject('Collection property',O);
O:=JS.StreamCollection(C);
DumpObject('StreamCollection result',O);
O:=JS.ObjectToJSON(C);
DumpObject('Passing collection to ObjectToJSON (returns an object)',O);
Writeln('Direct Collection to JSON String :');
Writeln(JS.CollectionToJSON(C));
Writeln;
finally
FreeAndNil(CC);
end;
finally
FreeAndNil(C);
end;
end;
Procedure DemoVariant;
Var
V : Variant;
O : TJSONData;
I : integer;
begin
V:=3;
O:=JS.StreamVariant(V);
DumpObject('Simple integer variant streaming',O);
V:=EncodeDate(2010,12,24);
O:=JS.StreamVariant(V);
DumpObject('Date variant streaming',O);
JS.Options:=[jsoDateTimeAsString];
O:=JS.StreamVariant(V);
DumpObject('Date variant streaming (Options:=[jsoDateTimeAsString];)',O);
V:=VarArrayCreate([1,10],varInteger);
For I:=1 to 10 do
V[i]:=11-I;
O:=JS.StreamVariant(V);
DumpObject('Variant arrays also work',O);
Writeln('Variant to JSON string :');
Writeln(JS.VariantToJSON(V));
Writeln('Variant to JSON string, with formatting :');
JS.Options:=[jsoUseFormatString];
Writeln(JS.VariantToJSON(V));
JS.Options:=[];
end;
begin
JS:=TJSONStreamer.Create(Nil);
try
DemoObject;
DemoObjectAsString;
DemoComponentObject;
DemoEnumObject;
DemoSetObject;
DemoStrings;
DemoCollection;
DemoVariant;
DemoChildObject;
Finally
FreeAndNil(JS);
end;
end.