Свойства Перечисления Подобъекта с Rtti

Question

Я пытаюсь рекурсивно перечислить опубликованные свойства объекта с помощью RTTI, чтобы получить строку структуры, подобную этому свойству = значение.Как я могу бросить подобъекты?

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;

Объект может быть для примера: TFill, который содержит подобъект TGradient, который содержит TGradientPoints (3 подуровня)

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

какМогу ли я перечислить все элементы объекта и дочерних объектов, пока не перейдем к базовым типам: строка, целое число, число с плавающей запятой и т. д ...?

Answer 1

я нашел рекурсивный вызов Sub-Object и запись (для TPointF) для 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.