如何将一个类实例的属性复制到同一类的另一个实例？

Question

我想复制一个类。我复制该类的所有属性就足够了。是否可以：

1. 循环访问类的所有属性？
2. 将每个属性分配给另一个属性，例如a.prop := b.prop？

getter 和 setter 应该处理底层的实现细节。

编辑： 正如弗朗索瓦指出的那样，我的问题措辞不够仔细。我希望问题的新措辞是更好的

解决方案： 利纳斯找到了正确的解决方案。下面找到一个小演示程序。派生类按预期工作。直到几个人指出我才知道新的 RTTI 可能性。非常有用的信息。谢谢大家。

  unit properties;

  interface

  uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
       Dialogs, StdCtrls,
       RTTI, TypInfo;

  type
     TForm1 = class(TForm)
        Memo1: TMemo;
        Button0: TButton;
        Button1: TButton;

        procedure Button0Click(Sender: TObject);
        procedure Button1Click(Sender: TObject);

     public
        procedure GetObjectProperties (AObject: TObject; AList: TStrings);
        procedure CopyObject<T: class>(ASourceObject, ATargetObject: T);
     end;

     TDemo = class (TObject)
     private
        FIntField: Int32;

        function  get_str_field: string;
        procedure set_str_field (value: string);

     public
        constructor Create; virtual;

        property IntField: Int32 read FIntField write FIntField;
        property StrField: string read get_str_field write set_str_field;
     end; // Class: TDemo //

     TDerived = class (TDemo)
     private
        FList: TStringList;

        function  get_items: string;
        procedure set_items (value: string);

     public
        constructor Create; override;
        destructor Destroy; override;
        procedure add_string (text: string);

        property Items: string read get_items write set_items;
     end;

  var Form1: TForm1;

  implementation

  {$R *.dfm}

  procedure TForm1.GetObjectProperties(AObject: TObject; AList: TStrings);
  var ctx: TRttiContext;
      rType: TRttiType;
      rProp: TRttiProperty;
      AValue: TValue;
      sVal: string;

  const SKIP_PROP_TYPES = [tkUnknown, tkInterface];

  begin
     if not Assigned(AObject) and not Assigned(AList) then Exit;

     ctx := TRttiContext.Create;
     rType := ctx.GetType(AObject.ClassInfo);
     for rProp in rType.GetProperties do
     begin
        if (rProp.IsReadable) and not (rProp.PropertyType.TypeKind in SKIP_PROP_TYPES) then
        begin
           AValue := rProp.GetValue(AObject);
           if AValue.IsEmpty then
           begin
              sVal := 'nil';
           end else
           begin
              if AValue.Kind in [tkUString, tkString, tkWString, tkChar, tkWChar]
                 then sVal := QuotedStr(AValue.ToString)
                 else sVal := AValue.ToString;
           end;
           AList.Add(rProp.Name + '=' + sVal);
        end;
     end;
  end;

  procedure TForm1.CopyObject<T>(ASourceObject, ATargetObject: T);
  const
    SKIP_PROP_TYPES = [tkUnknown, tkInterface, tkClass, tkClassRef, tkPointer, tkProcedure];
  var
    ctx: TRttiContext;
    rType: TRttiType;
    rProp: TRttiProperty;
    AValue, ASource, ATarget: TValue;
  begin
    Assert( Assigned(ASourceObject) and Assigned(ATargetObject) , 'Both objects must be assigned');
    ctx := TRttiContext.Create;
    rType := ctx.GetType(ASourceObject.ClassInfo);
    ASource := TValue.From<T>(ASourceObject);
    ATarget := TValue.From<T>(ATargetObject);

    for rProp in rType.GetProperties do
    begin
      if (rProp.IsReadable) and (rProp.IsWritable) and not (rProp.PropertyType.TypeKind in SKIP_PROP_TYPES) then
      begin
        //when copying visual controls you must skip some properties or you will get some exceptions later
        if SameText(rProp.Name, 'Name') or (SameText(rProp.Name, 'WindowProc')) then
          Continue;
        AValue := rProp.GetValue(ASource.AsObject);
        rProp.SetValue(ATarget.AsObject, AValue);
      end;
    end;
  end;

  procedure TForm1.Button0Click(Sender: TObject);
  var demo1, demo2: TDemo;
  begin
     demo1 := TDemo.Create;
     demo2 := TDemo.Create;
     demo1.StrField := '1023';

     Memo1.Lines.Add ('---Demo1---');
     GetObjectProperties (demo1, Memo1.Lines);
     CopyObject<TDemo> (demo1, demo2);

     Memo1.Lines.Add ('---Demo2---');
     GetObjectProperties (demo2, Memo1.Lines);
  end;

  procedure TForm1.Button1Click(Sender: TObject);
  var derivate1, derivate2: TDerived;
  begin
     derivate1 := TDerived.Create;
     derivate2 := TDerived.Create;
     derivate1.IntField := 432;
     derivate1.add_string ('ien');
     derivate1.add_string ('twa');
     derivate1.add_string ('drei');
     derivate1.add_string ('fjour');

     Memo1.Lines.Add ('---derivate1---');
     GetObjectProperties (derivate1, Memo1.Lines);
     CopyObject<TDerived> (derivate1, derivate2);

     Memo1.Lines.Add ('---derivate2---');
     GetObjectProperties (derivate2, Memo1.Lines);
  end;

  constructor TDemo.Create;
  begin
     IntField := 321;
  end; // Create //

  function TDemo.get_str_field: string;
  begin
     Result := IntToStr (IntField);
  end; // get_str_field //

  procedure TDemo.set_str_field (value: string);
  begin
     IntField := StrToInt (value);
  end; // set_str_field //

  constructor TDerived.Create;
  begin
     inherited Create;

     FList := TStringList.Create;
  end; // Create //

  destructor TDerived.Destroy;
  begin
     FList.Free;

     inherited Destroy;
  end; // Destroy //

  procedure TDerived.add_string (text: string);
  begin
     FList.Add (text);
  end; // add_string //

  function TDerived.get_items: string;
  begin
     Result := FList.Text;
  end; // get_items //

  procedure TDerived.set_items (value: string);
  begin
     FList.Text := value;
  end; // set_items //

  end. // Unit: properties //

Answer 1

尝试此代码（但我不建议复制可视组件的属性，因为那样您需要手动跳过一些属性）：

uses
  Rtti, TypInfo;

procedure CopyObject<T: class>(ASourceObject, ATargetObject: T);

procedure TForm1.CopyObject<T>(ASourceObject, ATargetObject: T);
const
  SKIP_PROP_TYPES = [tkUnknown, tkInterface, tkClass, tkClassRef, tkPointer, tkProcedure];
var
  ctx: TRttiContext;
  rType: TRttiType;
  rProp: TRttiProperty;
  AValue, ASource, ATarget: TValue;
begin
  Assert( Assigned(ASourceObject) and Assigned(ATargetObject) , 'Both objects must be assigned');
  ctx := TRttiContext.Create;
  rType := ctx.GetType(ASourceObject.ClassInfo);
  ASource := TValue.From<T>(ASourceObject);
  ATarget := TValue.From<T>(ATargetObject);

  for rProp in rType.GetProperties do
  begin
    if (rProp.IsReadable) and (rProp.IsWritable) and not (rProp.PropertyType.TypeKind in SKIP_PROP_TYPES) then
    begin
      //when copying visual controls you must skip some properties or you will get some exceptions later
      if SameText(rProp.Name, 'Name') or (SameText(rProp.Name, 'WindowProc')) then
        Continue;
      AValue := rProp.GetValue(ASource.AsObject);
      rProp.SetValue(ATarget.AsObject, AValue);
    end;
  end;
end;

使用示例：

CopyObject<TDemoObj>(FObj1, FObj2);

Answer 2

你的问题对我来说没有多大意义。

您真的想通过复制现有类来创建一个新类吗？

或者您是否正在尝试将某个类的实例 A 进行深层复制到同一类的另一个实例 B 中？
在这种情况下，请参阅另一个 SO 问题中关于克隆的讨论。

Answer 3

您没有提到您的 Delphi 版本，但这是一个好的开始。您需要探索 Delphi RTTI，它允许您获取运行时类型信息。您必须迭代类型的源类，然后提供分配每种类型的方法。

关于 RTTI

如果您正在设计自己的简单类，您可以覆盖 allocate 并在那里进行您自己的属性分配。