paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-21 21:50:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r44776 from trunk:

Browse Source 
------------------------------------------------------------------------
    r44776 | michael | 2020-04-18 12:48:08 +0200 (Sat, 18 Apr 2020) | 1 line
    
    * Refactored ObjectToJSON so descendents have more control (bug ID 36803)
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46627 -
This commit is contained in:
michael 2020-08-23 09:48:53 +00:00
parent eef66ba7aa
commit 57313b637a
1 changed files with 32 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
packages/fcl-json/src/fpjsonrtti.pp
View File

@ -54,6 +54,8 @@ Type
function IsChildStored: boolean; function IsChildStored: boolean;
function StreamChildren(AComp: TComponent): TJSONArray; function StreamChildren(AComp: TComponent): TJSONArray;
protected protected
Function GetPropertyList(aObject : TObject) : TPropInfoList; virtual;
Procedure StreamProperties(aObject : TObject;aList : TPropInfoList; aParent : TJSONObject); virtual;
function StreamClassProperty(Const AObject: TObject): TJSONData; virtual; function StreamClassProperty(Const AObject: TObject): TJSONData; virtual;
Function StreamProperty(Const AObject : TObject; Const PropertyName : String) : TJSONData; Function StreamProperty(Const AObject : TObject; Const PropertyName : String) : TJSONData;
Function StreamProperty(Const AObject : TObject; PropertyInfo : PPropInfo) : TJSONData; Function StreamProperty(Const AObject : TObject; PropertyInfo : PPropInfo) : TJSONData;
@ -757,12 +759,36 @@ begin
Result:=(GetChildProperty<>'Children'); Result:=(GetChildProperty<>'Children');
end; end;
Function TJSONStreamer.GetPropertyList(aObject : TObject) : TPropInfoList;
begin
result:=TPropInfoList.Create(AObject,tkProperties);
end;
Procedure TJSONStreamer.StreamProperties(aObject : TObject;aList : TPropInfoList; aParent : TJSONObject);
Var
I : Integer;
PD : TJSONData;
begin
For I:=0 to aList.Count-1 do
begin
PD:=StreamProperty(AObject,aList.Items[i]);
If (PD<>Nil) then
begin
if jsoLowerPropertyNames in Options then
aParent.Add(LowerCase(aList.Items[I]^.Name),PD)
else
aParent.Add(aList.Items[I]^.Name,PD);
end;
end;
end;
function TJSONStreamer.ObjectToJSON(Const AObject: TObject): TJSONObject; function TJSONStreamer.ObjectToJSON(Const AObject: TObject): TJSONObject;
Var Var
PIL : TPropInfoList; PIL : TPropInfoList;
PD : TJSONData;
I : Integer;
begin begin
Result:=Nil; Result:=Nil;
@ -782,20 +808,12 @@ begin
Result.Add('Objects', StreamTList(TList(AObject))) Result.Add('Objects', StreamTList(TList(AObject)))
else else
begin begin
PIL:=TPropInfoList.Create(AObject,tkProperties); PIL:=GetPropertyList(aObject);
// TPropInfoList.Create(AObject,tkProperties);
try try
For I:=0 to PIL.Count-1 do StreamProperties(aObject,PIL,Result);
begin
PD:=StreamProperty(AObject,PIL.Items[i]);
If (PD<>Nil) then begin
if jsoLowerPropertyNames in Options then
Result.Add(LowerCase(PIL.Items[I]^.Name),PD)
else
Result.Add(PIL.Items[I]^.Name,PD);
end;
end;
finally finally
FReeAndNil(Pil); FreeAndNil(Pil);
end; end;
If (jsoStreamChildren in Options) and (AObject is TComponent) then If (jsoStreamChildren in Options) and (AObject is TComponent) then
Result.Add(ChildProperty,StreamChildren(TComponent(AObject))); Result.Add(ChildProperty,StreamChildren(TComponent(AObject)));