delphi - variable - ¿Cómo copiar las propiedades de una instancia de clase a otra instancia de la misma clase?

llamar variable de otra clase java

Question

Quiero duplicar una clase. Es suficiente que copie todas las propiedades de esa clase. Es posible que:

1. pasar por todas las propiedades de una clase?
2. asignar cada propiedad a la otra propiedad, como a.prop := b.prop ?

Los getters y setters deben encargarse de los detalles de implementación subyacentes.

EDITAR: Como Francois señaló que no dije mi pregunta con cuidado. Espero que la nueva redacción de la pregunta sea mejor

SOLUCIÓN: Linas obtuvo la solución correcta. Encuentre un pequeño programa de demostración a continuación. Las clases derivadas funcionan como se esperaba. No sabía sobre las nuevas posibilidades RTTI hasta que varias personas me señalaron. Información muy útil. Gracias a todos.

 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

No mencionó su versión de Delphi, pero este es un buen comienzo. Necesita explorar Delphi RTTI que le permite obtener información del tipo de tiempo de ejecución. Tendría que repetir la clase de origen para los tipos, luego proporcionar un método para asignar cada tipo.

Acerca de RTTI

Si está diseñando sus propias clases simples, puede simplemente anular la asignación y hacer sus propias asignaciones de propiedad allí.

Answer 2

Pruebe este código (pero no le aconsejo que copie las propiedades de los componentes visuales porque entonces tendrá que omitir algunas propiedades manualmente):

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;

Ejemplo de uso:

CopyObject<TDemoObj>(FObj1, FObj2);

Answer 3

Tu pregunta tal como está no tiene mucho sentido para mí.

¿Estás realmente tratando de crear una nueva clase copiando una existente?

¿O está tratando de hacer una copia profunda de una instancia A de una clase en otra instancia B de la misma clase?
En ese caso, vea esta discusión sobre la clonación en otra pregunta SO.