我想要复制一个类。我复制该类的所有属性就足够了。有可能：
a.prop := b.prop？getter和setter应该处理底层的实现细节。
编辑： 正如弗朗索瓦所指出的那样，我没有仔细地说出我的问题。我希望问题的新措辞更好
解： 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 //
答案 0 :(得分：4)
试试这段代码（但我不会建议复制可视组件的属性，因为那时你需要手动跳过一些属性）：
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);
答案 1 :(得分：1)
你的问题对我来说没有多大意义。
您是否真的想通过复制现有类来创建新类？
或者您是否尝试将实例类的深层复制添加到同一类的另一个实例 B中？<登记/> 在这种情况下，请参阅this discussion about cloning in another SO question.
答案 2 :(得分：1)
你没有提到你的Delphi版本，但这是一个好的开始。您需要探索Delphi RTTI，它允许您获取运行时类型信息。您必须为类型迭代源类，然后提供一种分配每种类型的方法。
如果您正在设计自己的简单类，则可以覆盖assign并在那里进行自己的属性赋值。