I want to duplicate a class. It is sufficient that I copy all properties of that class. Is it possible to:
- loop thru all properties of a class?
- assign each property to the other property, like
a.prop := b.prop?
The getters and setters should take care of the underlying implementation details.
EDIT: As Francois pointed out I did not word my question carefully enough. I hope the new wording of the question is better
SOLUTION: Linas got the right solution. Find a small demo program below. Derived classes work as expected. I didn't know about the new RTTI possibilities until several people pointed me at it. Very useful information. Thank you all.
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 //
Try this code (but I won't advise copying properties of visual components because then you'll need to manually skip some properties):
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;
Usage example:
CopyObject<TDemoObj>(FObj1, FObj2);
Your question as it is does not make much sense to me.
Are you really trying to create a new class by copying an existing one?
Or are you trying to do a deep copy of an instance A of a class into another instance B of the same class?
In that case, see this discussion about cloning in another SO question.
You didn't mention your Delphi version, but here's a good start. You need to explore the Delphi RTTI which allows you to obtain runtime type information. You'd have to iterate your source class for types, then provide a method for assigning each type.
If you're designing your own simple classes, you could just override assign and do your own property assignments there.
来源：https://stackoverflow.com/questions/8682883/how-to-copy-the-properties-of-one-class-instance-to-another-instance-of-the-same