0

我有一个“父”类，它具有一个通用函数，可以将 JSON 字符串加载到名为loadVals的实例属性中。我有两个孩子，有自己的财产，其中一个道具就是唱片。该函数成功设置了主实例的所有道具，但在设置记录道具的值时失败，没有错误，我可以看到它成功循环通过记录的道具但没有设置值。编写了一个小型测试控制台应用程序，您可以在其中查看行为。

uses
  System.SysUtils, System.TypInfo, RTTI, Data.DBXJSON;

type
  TFieldValLoader = reference to procedure (const new_val: TValue);

  tRec1 = record
    x: integer;
    y: String;
  end;

  tRec2 = record
    a: integer;
    b: String;
    c: integer;
  end;

  TMyParent = class(TObject)
    procedure loadVals(json_obj: TJSONObject);
  end;

  TMyChild1 = class(TMyParent)
    h: integer;
    my_rec: tRec1;
  end;

  TMyChild2 = class(TMyParent)
    j: string;
    my_rec: tRec2;
  end;

{ TMyParent }
procedure TMyParent.loadVals(json_obj: TJSONObject);
   procedure loadObj(Obj : TObject; my_json_obj: TJSONObject); forward;
  procedure loadRecord(Obj : TValue; my_json_obj: TJSONObject);forward;

  Procedure loadField( my_json_val: TJSONPair; _val: TValue; _loader: TFieldValLoader );
  Begin
    case _val.TypeInfo.Kind of
      tkInteger:
        _loader( TValue.From<integer>(StrToInt(my_json_val.JsonValue.Value)));
      tkWChar, tkUString, tkVariant:
        _loader( TValue.From(my_json_val.JsonValue.Value));
      tkRecord:
        loadRecord(_val, my_json_val.JsonValue as TJSONObject);
    end;
  End;

  procedure loadRecord(obj : TValue; my_json_obj: TJSONObject);
  var
    i: Integer;
    json_pair: TJSONPair;

    ctx: TRttiContext;
    obj_type: TRttiType;
    my_field: TRttiField;
  begin
    ctx := TRttiContext.Create;
    obj_type := ctx.GetType(obj.TypeInfo);
    for I := 0 to my_json_obj.Size - 1 do
    Begin
      json_pair := my_json_obj.get(i);
      my_field := obj_type.GetField(json_pair.JsonString.value);
      WriteLn('    - '+ my_field.Name);
      loadField(json_pair, my_field.GetValue(obj.GetReferenceToRawData),
        procedure( const new_val: TValue )
        Begin
        // This does not work. (no feedback)!!!!
          my_field.SetValue(obj.GetReferenceToRawData, new_val);
        End
      );
    End;
  End;

  procedure loadObj(Obj : TObject; my_json_obj: TJSONObject);
  var
    i: Integer;
    json_pair: TJSONPair;

    ctx: TRttiContext;
    obj_type: TRttiType;
    my_field: TRttiField;
  begin
    ctx := TRttiContext.Create;
    obj_type := ctx.GetType(obj.ClassInfo);
    for I := 0 to my_json_obj.Size - 1 do
    Begin
      json_pair := my_json_obj.get(i);
      my_field := obj_type.GetField(json_pair.JsonString.value);
      WriteLn('* '+ my_field.Name);
      loadField(json_pair, my_field.GetValue(obj),
        procedure( const new_val: TValue )
        Begin
        // This does work
          my_field.SetValue(obj, new_val);
        End
      );
    End;
  End;
begin
  WriteLn('Loading  '+ self.ClassName);
  loadObj(self, json_obj);
end;

{ main Test Procedure }
var
  my_child1: TMyChild1;
  my_child2: TMyChild2;
begin
  try
    my_child1:= TMyChild1.Create;
    my_child2:= TMyChild2.Create;
    try
    // load the json objs
      my_child1.loadVals(TJSONObject.ParseJSONValue('{"h": 2, "my_rec": {"x": 4, "y": "test"}}') as TJSONObject);
      my_child2.loadVals(TJSONObject.ParseJSONValue('{"j": "some", "my_rec": {"a": 8, "b": "any", "c": 9}}') as TJSONObject);

    // print the loaded values
      WriteLn('child 1 vals are: h: '+ intToStr(my_child1.h) +'  my_rec.y= "'+ my_child1.my_rec.y +'" should equal to "test"');
      WriteLn('child 2 vals are: j: '+ my_child2.j +'  my_rec.b= "'+ my_child2.my_rec.b +'" should equal to "any"');

    finally
      my_child1.Free;
      my_child2.Free;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  // don't close the window, wait for [Enter]
  Readln;
end.

我知道记录与类不同，我找不到让这个函数工作的方法；我真的很感激任何帮助。谢谢

4

1 回答 1

1

您的问题是记录是一种值类型。

这条线

loadField(json_pair, my_field.GetValue(obj),

获取记录字段的值。请记住，它是一个值类型，所以我们得到它的副本。现在，您正在该副本上设置有效的属性/字段。但是，您永远不会将其分配回对象的字段。

所以你在这里做的基本上是这样的：

my_child1:= TMyChild1.Create;
my_rec1 := my_child1.my_rec;
my_rec1.x := 4;
my_rec1.y := 'test';

因此，您可以看到my_child1.my_rec永远不会将值设置为my_rec1.

您需要修复loadField如下：

procedure loadField( my_json_val: TJSONPair; _val: TValue; _loader: TFieldValLoader );
begin
  case _val.TypeInfo.Kind of
    tkInteger:
      _loader( TValue.From<integer>(StrToInt(my_json_val.JsonValue.Value)));
    tkWChar, tkUString, tkVariant:
      _loader( TValue.From(my_json_val.JsonValue.Value));
    tkRecord:
    begin
      loadRecord(_val, my_json_val.JsonValue as TJSONObject);
      _loader( _val); // <- set the record back to the field
    end;
  end;
end;
于 2013-02-27T07:32:16.887 回答