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

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

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

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

РЕДАКТИРОВАТЬ: Как отметил Франсуа, я недостаточно тщательно сформулировал свой вопрос. Я надеюсь, что новая формулировка вопроса лучше

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

person Arnold    schedule 30.12.2011    source источник
comment
Какую версию Delphi вы используете?   -  person Linas    schedule 30.12.2011
comment
Есть недавний вопрос, похожий на ваш, ответы там используют новый RTTI и, следовательно, требуют Delphi версии 2010 или новее, см. stackoverflow.com/ q/8679735/723693   -  person ain    schedule 30.12.2011
comment
Покажите, что вы уже закодировали. Это важный вклад. Ваш вопрос все еще неясен: например. опубликованы ли эти свойства? класс происходит от TPersistent? какая версия компилятора?   -  person menjaraz    schedule 30.12.2011
comment
Геттеры и сеттеры должны заботиться о базовых деталях реализации. Это требование или свойство классов, с которыми вы будете работать?   -  person David Heffernan    schedule 30.12.2011
comment
@Francois, вопрос должен быть таким: как я могу скопировать один экземпляр класса в другой. Использование DelphiXE. Я ничего не кодировал, потому что не смог найти ничего о копировании свойств Delphi. Поскольку всю функциональность в конечном итоге можно найти в свойствах, я просто хочу скопировать все свойства класса, отсюда и замечание геттеров и сеттеров. Нет никаких предположений о родительском классе. Сейчас я просматриваю ссылку.   -  person Arnold    schedule 31.12.2011
comment
@ain, ваша ссылка отлично работает при копировании экземпляра. Спасибо! Завтра попробую скопировать один экземпляр на другой.   -  person Arnold    schedule 31.12.2011


Ответы (3)


Попробуйте этот код (но я не советую копировать свойства визуальных компонентов, потому что тогда вам нужно будет вручную пропустить некоторые свойства):

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);
person Linas    schedule 31.12.2011
comment
Я начал с того же базового кода, в котором я перечислил все свойства, но еще не нашел решения для копирования свойств. Спасибо за ваше решение, которое отлично работает. Я бы не подумал о применении дженериков, что действительно делает это изящным решением. Я не собираюсь копировать визуальные объекты, просто некоторые созданные мной объекты, но спасибо за предупреждение. - person Arnold; 31.12.2011

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

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

Или вы пытаетесь сделать глубокую копию экземпляра A класса в другой экземпляр B того же класса?
В в этом случае см. это обсуждение клонирования в другом вопросе SO.

person Francesca    schedule 30.12.2011

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

О RTTI

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

person John Easley    schedule 30.12.2011
comment
Пожалуйста, воздержитесь от маскировки ссылок (включая фреймы about.com), спасибо! - person OnTheFly; 31.12.2011