Search code examples
objectdelphirttidelphi-10.3-rio

Sub-Object Enumeration properties with Rtti


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... ?


Solution

  • 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.