问题描述
我想重复一堂课。复制该类的所有属性就足够了。是否可以:
I want to duplicate a class. It is sufficient that I copy all properties of that class. Is it possible to:
- 通过类的所有属性循环?
- 将每个属性分配给其他属性,例如
a.prop:= b.prop
?
- 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.
编辑:
正如Francois指出的那样,我对问题的措辞不够仔细。我希望问题的新措词更好
As Francois pointed out I did not word my question carefully enough. I hope the new wording of the question is better
解决方案:
Linas得到了正确的解决方案。在下面找到一个小型演示程序。派生类按预期工作。我不知道新的RTTI可能性,直到有几个人向我指出。非常有用的信息。谢谢大家。
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;
用法示例:
CopyObject<TDemoObj>(FObj1, FObj2);
这篇关于如何将一个类实例的属性复制到同一类的另一个实例?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!