Как скопировать свойства экземпляра одного класса в другой экземпляр одного класса?

Question

Я хочу дублировать класс. Достаточно скопировать все свойства этого класса. Можно ли:

1. цикл через все свойства класса?
2. присваивать каждое имущество другому имуществу, например a.prop := b.prop?

Получатели и сеттеры должны позаботиться о базовых деталях реализации.

EDIT: Как указал Франсуа, я не очень подробно изложил свой вопрос. Я надеюсь, что новая формулировка вопроса лучше

РЕШЕНИЕ: Linas получил правильное решение. Найдите небольшую демонстрационную программу ниже. Производные классы работают так, как ожидалось. Я не знал о новых возможностях 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

Ваш вопрос как есть, не имеет для меня большого смысла.

Вы действительно пытаетесь создать новый класс, скопировав существующий?

Или вы пытаетесь сделать глубокую копию о качестве экземпляра А класса в другой например B одного и того же класса?
В этом случае см. this discussion about cloning in another SO question.

Answer 3

Вы не указали свою версию Delphi, но вот хорошее начало. Вам необходимо изучить Delphi RTTI, который позволяет вам получать информацию о времени исполнения. Вам придется перебирать исходный класс для типов, а затем предоставлять метод для назначения каждого типа.

About RTTI

Если вы разрабатываете свои собственные простые классы, вы могли бы просто переопределить назначающий и сделать свои собственные задания свойств там.