0

loadValsと呼ばれるインスタンスのプロパティにJSON文字列をロードするジェネリック関数を持つ「親」クラスがあります。私には2人の子供がいて、それぞれの特性があります。これらの小道具の1つはレコードです。この関数は、メインインスタンスのすべての小道具を正常に設定しますが、レコードの小道具に値を設定できません。エラーはありません。レコードの小道具を正常にループしますが、値を設定しません。動作を確認できる小さなテストコンソールアプリを作成しました。

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 に答える