Question

我尝试使用RTTI递归枚举对象发布的属性，以获取类似此属性= value的结构字符串。我该如何扔子对象？

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;

该对象可以例如：包含一个TGradient子对象的TFill，其中包含TGradientPoints（三个子级别）

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

我如何枚举对象和子对象的所有元素，直到使用基本类型：字符串，整数，浮点数等？？

Answer 1

我发现了Delphi 10.3 Rio的Sub-Object递归调用和记录（对于TPointF）

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.

Rtti

1 个答案: