Sub-Object Enumeration properties with Rtti

Question

I try to enumerate an object published properties recursively with RTTI to get a string of the structure like this property = value. How can i go threw sub-objects ?

class function TJSONUtils.ToString(aSender : TObject ; aLevel : integer = 0) : string;
const
  SKIP_PROP_TYPES = [tkUnknown, tkInterface];
var
  vC : TRttiContext;
  vType : TRttiType;
  vProperty : TRttiProperty;
  s : string;
  vValue : TValue;
  vVal: string;
begin
  vC := TRttiContext.Create;
  vType := vC.GetType(aSender.ClassInfo);
  for vProperty in vType.GetProperties do
  begin
    if (vProperty.IsReadable) and not (vProperty.PropertyType.TypeKind in SKIP_PROP_TYPES) and (vProperty.Visibility = mvPublished ) then
    begin
      AValue := vProperty.GetValue(aSender);
      if AValue.IsEmpty then
      begin
         vVal := 'nil';
      end
      else
      begin
        if AValue.Kind in [tkUString, tkString, tkWString, tkChar, tkWChar] then
          vVal := QuotedStr(AValue.ToString)
        else
          vVal := AValue.ToString;
      end;

      if pos(' @', sval) > 0 then
      begin
        s := s +  vProperty.Name + '  => ' + TJSONUtils.ToString(TObject(AValue)); // here is the problem
      end
      else
        s := s + inttostr(aLevel) + ' - ' + vProperty.Name + '=' + vVal + #$D#$A;
    end;
  end;

  result := s;
end;

The object can be for exemple : TFill that contain a TGradient sub object, that containt TGradientPoints (3 sublevels)

var
  fFill   : TBrush;
begin
  fFill := TBrush.create;
  try
    showmessage(TJSONUtils.ToString(fFill, 0));
  finally
    fFill.free;
  end;
end;

how can i enumerate all elements of object and sub objects until going to base types : string, integer, float, etc... ?

ffert2907 ffert2907 · Accepted Answer · 2019-02-12T13:56:20

i found Sub-Object recursive call and Record (for TPointF) for Delphi 10.3 Rio

unit JSON.Serialization;

interface

uses
  REST.JSON, System.Generics.Collections, system.JSON, RTTI, Winapi.Windows,
  TypInfo, System.Types;

type

  TJSONUtils = class(TJSON)
  private
  public
    class function ToString(aSender: TObject ; aParentProperty : string = '' ; aLevel : integer = 0): string; static;
  end;

implementation

uses
  System.SysUtils;


{TJSONHelper}
class function TJSONUtils.ToString(aSender : TObject ; aParentProperty : string = '' ; aLevel : integer = 0) : string;
const
  SKIP_PROP_TYPES = [tkUnknown, tkInterface];
var
  vC : TRttiContext;
  vType : TRttiType;
  vProperty : TRttiProperty;
  s : string;
  vValue : TValue;
  vVal : string;
  vProName : string;
  vPointF: TPointF;
  vPtrvPointF : PInteger;
begin
  vC := TRttiContext.Create;

  vType := vC.GetType(aSender.ClassInfo);
  for vProperty in vType.GetProperties do
  begin
    if (vProperty.IsReadable) and not (vProperty.PropertyType.TypeKind in SKIP_PROP_TYPES) and (vProperty.Visibility = mvPublished ) then
    begin
      vValue := vProperty.GetValue(aSender);
      vProName := vProperty.Name;
      if vValue.IsEmpty then
      begin
         vVal := 'nil';
      end
      else if vValue.isObject then
      begin
        vval := TJSONUtils.ToString(vValue.AsObject, vProperty.Name, aLevel + 1);
      end
      else if vProperty.PropertyType.Name = 'TPointF' then
      begin
        // get record details for TPointF
        vPtrvPointF := @vPointF.X;  // Get pointer to first X value
        vVal := System.SysUtils.Format('%d', [vPtrvPointF^]);
        s := s + inttostr(aLevel) + ' - ' + aParentProperty + '.' + vProName + '.X' + '=' + vVal + #$D#$A;
        Inc(vPtrvPointF);  // go to Y value
        vVal := System.SysUtils.Format('%d', [vPtrvPointF^]);
        vProName := vProperty.Name +  '.Y';
      end
      else if vValue.ToString = '(record)' then
      begin
        // Another Record to analyse... ???
      end
      else
      begin
        if vValue.Kind in [tkUString, tkString, tkWString, tkChar, tkWChar] then
          vVal := QuotedStr(vValue.ToString)
        else
          vVal := vValue.ToString;
      end;
      s := s + inttostr(aLevel) + ' - ' + aParentProperty + '.' + vProName + '=' + vVal + #$D#$A;
    end;
  end;

  result := s;
end;
end.

Sub-Object Enumeration properties with Rtti

1 Answers