Given the following code snippet below, using GetPropValue(MyComponent,'MySubComponent.Prop1') raises an EPropertyError exception.
How can I retrieve or set the values of SubProperties using GetPropValue / SetPropValue?
Type
TMySubComponent = class(TInterfacedPersitent)
private
FProp1: Integer;
published
property Prop1: integer read FProp1 write FProp1;
end;
TMyComponent = class(TCompoent)
private
FMySubComponent : TMySubcomponent;
published
property MySubComponent: TMySubComponent read FMySubComponent write FMySubComponent ;
end;
As Robert says the dot notation is not supported , but you can create easily a function to set or get a sub-property value using the RTTI. check this sample
{$APPTYPE CONSOLE}
uses
Rtti,
Classes,
SysUtils;
Type
TMySubComponent = class(TInterfacedPersistent)
private
FProp1: Integer;
published
property Prop1: integer read FProp1 write FProp1;
end;
TMyComponent = class(TComponent)
private
FMySubComponent : TMySubcomponent;
published
property MySubComponent: TMySubComponent read FMySubComponent write FMySubComponent ;
end;
procedure SetObjValueEx(const ObjPath:string;AInstance:TObject;AValue:TValue);
Var
c : TRttiContext;
Prop : string;
SubProp : string;
pm : TRttiProperty;
p : TRttiProperty;
Obj : TObject;
begin
Prop:=Copy(ObjPath,1,Pos('.',ObjPath)-1);
SubProp:=Copy(ObjPath,Pos('.',ObjPath)+1);
c := TRttiContext.Create;
try
for pm in c.GetType(AInstance.ClassInfo).GetProperties do
if CompareText(Prop,pm.Name)=0 then
begin
p := c.GetType(pm.PropertyType.Handle).GetProperty(SubProp);
if Assigned(p) then
begin
Obj:=pm.GetValue(AInstance).AsObject;
if Assigned(Obj) then
p.SetValue(Obj,AValue);
end;
break;
end;
finally
c.Free;
end;
end;
function GetObjValueEx(const ObjPath:string;AInstance:TObject):TValue;
Var
c : TRttiContext;
Prop : string;
SubProp : string;
pm : TRttiProperty;
p : TRttiProperty;
Obj : TObject;
begin
Prop:=Copy(ObjPath,1,Pos('.',ObjPath)-1);
SubProp:=Copy(ObjPath,Pos('.',ObjPath)+1);
c := TRttiContext.Create;
try
for pm in c.GetType(AInstance.ClassInfo).GetProperties do
if CompareText(Prop,pm.Name)=0 then
begin
p := c.GetType(pm.PropertyType.Handle).GetProperty(SubProp);
if Assigned(p) then
begin
Obj:=pm.GetValue(AInstance).AsObject;
if Assigned(Obj) then
Result:=p.GetValue(Obj);
end;
break;
end;
finally
c.Free;
end;
end;
Var
MyComp : TMyComponent;
begin
try
MyComp:=TMyComponent.Create(nil);
try
MyComp.MySubComponent:=TMySubComponent.Create;
//Set the value of the property
SetObjValueEx('MySubComponent.Prop1',MyComp,777);
//Get the value of the property
Writeln(Format('The value of MySubComponent.Prop1 is %d',[GetObjValueEx('MySubComponent.Prop1',MyComp).AsInteger]));
finally
MyComp.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
The dot notation you used in your question is not supported.
You need to get the Value of the SubComponent, then perform the Set and Get on the individual properties.
var
C: TRttiContext;
MyComp : TMyComponent;
MyCompType : TRttiInstanceType;
MySubCompType : TRttiInstanceType;
MySubComponentValue : TValue;
begin
MyComp := TMyComponent.create(Self);
...
// RTTI.Pas Method
MyCompType := c.GetType(TMyComponent.ClassInfo) as TRttiInstanceType;
MySubCompType := c.GetType(TMySubComponent.ClassInfo) as TRttiInstanceType;
MySubComponentValue := MyCompType.GetProperty('MySubComponent').GetValue(MyComp);
if Not MySubComponentValue.IsEmpty then
begin
MySubCompType.GetProperty('Prop1').SetValue(MySubComponentValue.AsObject,43);
end;
//TypInfo.pas Method
SubComp := GetObjectProp(MyComp,'MySubComponent');
if Assigned(SubComp) then
begin
SetPropValue(SubComp,'Prop1',5);
prop1Value := GetPropValue(SubComp,'Prop1');
end;
end;
The TypInfo.pas method will only work with published properties, you can get the public properties with the RTTI.pas method.
Related
I am using a generic class to allow me to access a named property of a generic type and read/write its value. I am getting an EAccessViolation error when trying to access the result from a call to GetValue from a RTTIProperty record and also when setting a value using SetValue. When running a trace it seems both errors are being thrown when access the TValue. I have included a sample console app below that highlights the issue.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.RTTI;
Type
TTestClass = class
private
FItem: string;
public
Property Item: string read FItem write FItem;
end;
TAccessData<T> = class
Function GetTValue(AItem : T; AField : string) : TValue;
Procedure SetTValue(AItem : T; Afield : string; AValue : TValue);
end;
{ TAccessData<T> }
function TAccessData<T>.GetTValue(AItem: T; AField: string): TValue;
var
LContext : TRTTIContext;
LType : TRttiType;
LProperty : TRttiProperty;
begin
result := nil;
LType := LContext.GetType(Typeinfo(T));
LProperty := LType.GetProperty(Afield);
if LProperty <> nil then
Result := LProperty.GetValue(#AItem);
end;
var
LTestObj : TTestClass;
LAccessOBj : TAccessData<TTestClass>;
AValue : TValue;
procedure TAccessData<T>.SetTValue(AItem: T; Afield: string; AValue: TValue);
var
LContext : TRTTIContext;
LType : TRttiType;
LProperty : TRttiProperty;
begin
LType := LContext.GetType(Typeinfo(T));
LProperty := LType.GetProperty(Afield);
if LProperty <> nil then
LProperty.SetValue(#AItem, AValue);
end;
begin
try
LTestObj := TTestClass.Create;
LTestObj.Item := 'Hello';
Writeln(LTestObj.Item);
LAccessOBj := TAccessData<TTestClass>.Create;
AValue := LAccessObj.GetTValue(LTestObj, 'Item');
Writeln(AValue.TypeInfo^.Name);
if AValue.TypeInfo.Kind <> tkString then
Writeln('Not string');
Writeln(AValue.ToString); // <--- This results in a EAccessViolation
LAccessOBj.SetTValue(LTestObj,'Item','World'); // <--- This results in a EAccessViolation
Writeln(LTestObj.Item);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
I suspect I am missing something in the way I am accessing the properties of the generic types but have hit a wall as to why I am getting this behaviour. I have not made a constraint on the generic parameter as I need this to work with record types as well.
Using Tokyo update 1
Your code in GetTValue and SetTValue is defect as it passes #AItem to TRttiProperty.SetValue and GetValue. It needs to be PPointer(#AItem)^ or constrain T to class so you can directly hardcast with Pointer(AItem).
Due to the wrong passed AInstance the TValue contains some garbage memory which you can see if you introduce a string variable and assign the result of the ToString call to it before trying to pass it to Writeln. And the code in Writeln is then producing the AV.
I have several classes with properties of simple types (Integer, Boolean, string) and some Nullable's:
Nullable<T> = record
private
FValue: T;
FHasValue: IInterface;
function GetValue: T;
function GetHasValue: Boolean;
public
constructor Create(AValue: T);
property HasValue: Boolean read GetHasValue;
property Value: T read GetValue;
end;
Eg.
TMyClass1 = class(TCommonAncestor)
private
FNumericvalue: Double;
FEventTime: Nullable<TDateTime>;
public
property NumericValue: Double read FNumericValue write FNumericValue;
property EventTime: Nullable<TDateTime> read FEventTime write FEventTime;
end;
and
TMyClass2 = class(TCommonAncestor)
private
FCount: Nullable<Integer>;
FName: string;
public
property Count: Nullable<Integer> read FCount write FCount;
property Name: string read FName write FName;
end;
etc....
Given a descendant of TCommonAncestor, I would like to use RTTI to iterate all public properties and list their name and value, unless it is a Nullable where T.HasValue returns false.
I am using Delphi XE2.
EDIT: added what I have so far.
procedure ExtractValues(Item: TCommonAncestor);
var
c : TRttiContext;
t : TRttiType;
p : TRttiProperty;
begin
c := TRttiContext.Create;
try
t := c.GetType(Item.ClassType);
for p in t.GetProperties do
begin
case p.PropertyType.TypeKind of
tkInteger:
OutputDebugString(PChar(Format('%se=%s', [p.Name,p.GetValue(Item).ToString]));
tkRecord:
begin
// for Nullable<Double> p.PropertyType.Name contains 'Nullable<System.Double>'
// but how do I go about accessing properties of this record-type field?
end;
end;
end;
finally
c.Free;
end;
end;
The following works for me in XE2:
uses
System.SysUtils, System.TypInfo, System.Rtti, System.StrUtils, Winapi.Windows;
type
Nullable<T> = record
private
FValue: T;
FHasValue: IInterface;
function GetHasValue: Boolean;
function GetValue: T;
procedure SetValue(const AValue: T);
public
constructor Create(AValue: T);
function ToString: string; // <-- add this for easier use!
property HasValue: Boolean read GetHasValue;
property Value: T read GetValue write SetValue;
end;
TCommonAncestor = class
end;
TMyClass1 = class(TCommonAncestor)
private
FNumericvalue: Double;
FEventTime: Nullable<TDateTime>;
public
property NumericValue: Double read FNumericValue write FNumericValue;
property EventTime: Nullable<TDateTime> read FEventTime write FEventTime;
end;
TMyClass2 = class(TCommonAncestor)
private
FCount: Nullable<Integer>;
FName: string;
public
property Count: Nullable<Integer> read FCount write FCount;
property Name: string read FName write FName;
end;
...
constructor Nullable<T>.Create(AValue: T);
begin
SetValue(AValue);
end;
function Nullable<T>.GetHasValue: Boolean;
begin
Result := FHasValue <> nil;
end;
function Nullable<T>.GetValue: T;
begin
if HasValue then
Result := FValue
else
Result := Default(T);
end;
procedure Nullable<T>.SetValue(const AValue: T);
begin
FValue := AValue;
FHasValue := TInterfacedObject.Create;
end;
function Nullable<T>.ToString: string;
begin
if HasValue then
begin
// TValue.ToString() does not output T(Date|Time) values as date/time strings,
// it outputs them as floating-point numbers instead, so do it manually...
if TypeInfo(T) = TypeInfo(TDateTime) then
Result := DateTimeToStr(PDateTime(#FValue)^)
else if TypeInfo(T) = TypeInfo(TDate) then
Result := DateToStr(PDateTime(#FValue)^)
else if TypeInfo(T) = TypeInfo(TTime) then
Result := TimeToStr(PDateTime(#FValue)^)
else
Result := TValue.From<T>(FValue).ToString;
end
else
Result := '(null)';
end;
procedure ExtractValues(Item: TCommonAncestor);
var
c : TRttiContext;
t : TRttiType;
p : TRttiProperty;
v : TValue;
m : TRttiMethod;
s : string;
begin
c := TRttiContext.Create;
t := c.GetType(Item.ClassType);
for p in t.GetProperties do
begin
case p.PropertyType.TypeKind of
tkRecord:
begin
if StartsText('Nullable<', p.PropertyType.Name) then
begin
// get Nullable<T> instance...
v := p.GetValue(Item);
// invoke Nullable<T>.ToString() method on that instance...
m := c.GetType(v.TypeInfo).GetMethod('ToString');
s := m.Invoke(v, []).AsString;
end else
s := Format('(record type %s)', [p.PropertyName.Name]);
end;
else
s := p.GetValue(Item).ToString;
end;
OutputDebugString(PChar(Format('%s=%s', [p.Name, s])))
end;
end;
var
Item1: TMyClass1;
Item2: TMyClass2;
begin
Item1 := TMyClass1.Create;
try
Item1.NumericValue := 123.45;
Item1.EventTime.SetValue(Now);
ExtractValues(Item1);
{ Output:
NumericValue=123.45
EventTime=10/19/2017 1:25:05 PM
}
finally
Item1.Free;
end;
Item1 := TMyClass1.Create;
try
Item1.NumericValue := 456.78;
//Item1.EventTime.SetValue(Now);
ExtractValues(Item1);
{ Output:
NumericValue=456.78
EventTime=(null)
}
finally
Item1.Free;
end;
Item2 := TMyClass2.Create;
try
Item2.Count.SetValue(12345);
Item2.Name := 'test';
ExtractValues(Item2);
{ Output:
Count=12345
Name=test
}
finally
Item2.Free;
end;
Item2 := TMyClass2.Create;
try
//Item2.Count.SetValue(12345);
Item2.Name := 'test2';
ExtractValues(Item2);
{ Output:
Count=(null)
Name=test2
}
finally
Item2.Free;
end;
end;
Rtti accessing fields, properties and invoke method in record structures.
I use the following record types, is from site
type
Nullable<T> = record
public
FValue: T;
FHasValue: boolean;
procedure Clear;
function GetHasValue: boolean;
function GetValue: T;
constructor Create(AValue: T);
property HasValue: boolean read GetHasValue;
property Value: T read GetValue;
class operator Implicit(Value: Nullable<T>): T;
class operator Implicit(Value: T): Nullable<T>;
end;
type
TIntEx = Nullable<integer>;
TSmallintEx = Nullable<smallint>;
implementation
constructor Nullable<T>.Create(AValue: T);
begin
FValue := AValue;
FHasValue := false;
end;
function Nullable<T>.GetHasValue: boolean;
begin
Result := FHasValue;
end;
function Nullable<T>.GetValue: T;
begin
Result := FValue;
end;
class operator Nullable<T>.Implicit(Value: Nullable<T>): T;
begin
Result := Value.Value;
end;
class operator Nullable<T>.Implicit(Value: T): Nullable<T>;
begin
Result := Nullable<T>.Create(Value);
end;
But with a record this code doesn't work
type
[TableName('Record')]
TMyrecord = class(TPersistent)
private
FRecno: TIntEx;
FName: TStringEx;
protected
public
constructor Create();
destructor Destoy();
function GetSqlInsert(): string;
[SqlFieldName('recno')]
property Recno: TIntEx read FRecno write FRecno;
[SqlFieldName('Name')]
property Name: TStringEx read FName write FName;
end;
implementation
{ TMyrecord }
function TMyrecord.GetSqlInsert(): string;
var
vCtx: TRttiContext;
vType: TRttiType;
vProp: TRttiProperty;
vAttr: TCustomAttribute;
vPropValue: TValue;
vRecord: TRttiRecordType;
M: TRttiMethod;
tmpStr: String;
val: TValue;
begin
result := '';
vCtx := TRttiContext.Create;
try
vType := vCtx.GetType(self);
for vProp in vType.GetProperties do
for vAttr in vProp.GetAttributes do
if vAttr is SqlFieldName then
begin
if (vProp.IsReadable) and (vProp.IsWritable) and
(vProp.PropertyType.TypeKind = tkRecord) then
begin
vRecord := vCtx.GetType(vProp.GetValue(self).TypeInfo).AsRecord;
M := vRecord.GetMethod('GetValue');
if Assigned(M) then
vPropValue := (M.Invoke(vPropValue, []));
tmpStr := val.ToString;
end;
end;
finally
freeandnil(vCtx);
end;
end;
I studied all the examples on the internet but in vain.
vType := vCtx.GetType(self);
The GetType method expects to be pass a pointer to type info, or a class, but you pass an instance. Instead you should pass the class like this:
vType := vCtx.GetType(ClassType);
You must not pass a TRttiContext to FreeAndNil. The TRttiContext type is a record. You don't need to call Create on that type. You don't need to call Free.
Further more, your code to invoke the method is just wrong.
Your function might look like this:
function TMyrecord.GetSqlInsert(): string;
var
vCtx: TRttiContext;
vType: TRttiType;
vProp: TRttiProperty;
vAttr: TCustomAttribute;
vRecord: TValue;
M: TRttiMethod;
begin
vType := vCtx.GetType(ClassType);
for vProp in vType.GetProperties do
for vAttr in vProp.GetAttributes do
if vAttr is SqlFieldNameAttribute then
begin
if (vProp.IsReadable) and (vProp.IsWritable) and
(vProp.PropertyType.TypeKind = tkRecord) then
begin
vRecord := vProp.GetValue(self);
M := vProp.PropertyType.GetMethod('GetValue');
if Assigned(M) then
begin
Result := M.Invoke(vRecord, []).ToString;
exit;
end;
end;
end;
Result := '';
end;
That code does at least call the method and retrieve the returned value. I'll let you take it from there.
Delphi support generic for IInterface. I have the follow construct using generic IInterface:
type
IVisitor<T> = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(o: T);
end;
TMyVisitor = class(TInterfacedObject, IVisitor<TButton>, IVisitor<TEdit>)
procedure Visit(o: TButton); overload;
procedure Visit(o: TEdit); overload;
end;
implementation
procedure TMyVisitor.Visit(o: TButton);
begin
ShowMessage('Expected: TButton, Actual: ' + o.ClassName);
end;
procedure TMyVisitor.Visit(o: TEdit);
begin
ShowMessage('Expected: TEdit, Actual: ' + o.ClassName);
end;
TMyVisitor class implement two interface: IVisitor<TButton> and IVisitor<TEdit>.
I attempt invoke the methods:
procedure TForm6.Button1Click(Sender: TObject);
var V: IInterface;
begin
V := TMyVisitor.Create;
(V as IVisitor<TButton>).Visit(Button1);
(V as IVisitor<TEdit>).Visit(Edit1);
end;
The output I have is:
Expected: TEdit, Actual: TButton
Expected: TEdit, Actual: TEdit
Apparently, the code doesn't invoke procedure TMyVisitor.Visit(o: TButton) when execute (V as IVisitor<TButton>).Visit(Button1).
Is this a bug in Delphi or I should avoid implement multiple generic IInterface? All above codes have test in Delphi XE6.
as operator requires interface GUID to be able to tell which interface you are referring to. Since generic interfaces share same GUID as operator will not work with them. Basically, compiler cannot tell the difference between IVisitor<TButton> and IVisitor<TEdit> interfaces.
However, you can solve your problem using enhanced RTTI:
type
TCustomVisitor = class(TObject)
public
procedure Visit(Instance: TObject);
end;
TVisitor = class(TCustomVisitor)
public
procedure VisitButton(Instance: TButton); overload;
procedure VisitEdit(Instance: TEdit); overload;
end;
procedure TCustomVisitor.Visit(Instance: TObject);
var
Context: TRttiContext;
CurrentClass: TClass;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
s: string;
begin
Context := TRttiContext.Create;
CurrentClass := Instance.ClassType;
repeat
s := CurrentClass.ClassName;
Delete(s, 1, 1); // remove "T"
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then
begin
SelfMethod.Invoke(Self, [Instance]);
Exit;
end;
end;
end;
CurrentClass := CurrentClass.ClassParent;
until CurrentClass = nil;
end;
If you need to have Visitor interface you can change declarations to
type
IVisitor = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(Instance: TObject);
end;
TCustomVisitor = class(TInterfacedObject, IVisitor)
public
procedure Visit(Instance: TObject);
end;
You can then use that in following manner, just by calling Visit and appropriate Visit method will be called.
procedure TForm6.Button1Click(Sender: TObject);
var V: IVisitor;
begin
V := TMyVisitor.Create;
V.Visit(Button1);
V.Visit(Edit1);
end;
Above code is based on Uwe Raabe's code and you can read more http://www.uweraabe.de/Blog/?s=visitor
And here is extended visitor interface and class that can operate on non-class types. I have implemented only calls for string, but implementation for other types consists only of copy-paste code with different typecast.
IVisitor = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(const Instance; InstanceType: PTypeInfo);
procedure VisitObject(Instance: TObject);
end;
TCustomVisitor = class(TInterfacedObject, IVisitor)
public
procedure Visit(const Instance; InstanceType: PTypeInfo);
procedure VisitObject(Instance: TObject);
end;
procedure TCustomVisitor.Visit(const Instance; InstanceType: PTypeInfo);
var
Context: TRttiContext;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
begin
Context := TRttiContext.Create;
case InstanceType.Kind of
tkClass : VisitObject(TObject(Instance));
// template how to implement calls for non-class types
tkUString :
begin
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('VisitString') do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.TypeKind = tkUString then
begin
SelfMethod.Invoke(Self, [string(Instance)]);
Exit;
end;
end;
end;
end;
end;
end;
procedure TCustomVisitor.VisitObject(Instance: TObject);
var
Context: TRttiContext;
CurrentClass: TClass;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
s: string;
begin
Context := TRttiContext.Create;
CurrentClass := Instance.ClassType;
repeat
s := CurrentClass.ClassName;
Delete(s, 1, 1); // remove "T"
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then
begin
SelfMethod.Invoke(Self, [Instance]);
Exit;
end;
end;
end;
CurrentClass := CurrentClass.ClassParent;
until CurrentClass = nil;
end;
Enhanced Visitor can be used like this:
TVisitor = class(TCustomVisitor)
public
procedure VisitButton(Instance: TButton); overload;
procedure VisitEdit(Instance: TEdit); overload;
procedure VisitString(Instance: string); overload;
end;
var
v: IVisitor;
s: string;
begin
s := 'this is string';
v := TVisitor.Create;
// class instances can be visited directly via VisitObject
v.VisitObject(Button1);
v.Visit(Edit1, TypeInfo(TEdit));
v.Visit(s, TypeInfo(string));
end;
This is a well known problem with generic interfaces. Here is yours:
type
IVisitor<T> = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(o: T);
end;
Now, the as operator is implemented on top of the GUID that you specify for the interface. When you write:
(V as IVisitor<TButton>).Visit(Button1);
(V as IVisitor<TEdit>).Visit(Edit1);
how can the as operator distinguish between IVisitor<TButton> and IVisitor<TEdit>? You have only specified a single GUID. In fact when this happens, all instantiated types based on this generic interface share the same GUID. And so whilst the as operator compiles, and the code executes, the runtime behaviour is ill-defined. In effect you are defining multiple interfaces and giving them all the same GUID.
So, the fundamental issue here is that the as operator is not compatible with generic interfaces. You will have to find some other way to implement this. You might consider looking at the Spring4D project for inspiration.
Using Delphi 2010 and RTTI, I know how to get the class type of an object and how to get/set the value and type of an object's properties, but how do you determine which class in the inheritance chain a property came from? I want to use the properties of a base class differently than the main class.
Consider this code:
TClassBase = class(TObject)
published
property A: Integer;
end;
TClassDescendant = class(TClassBase)
published
property B: Integer;
end;
procedure CheckProperties(Obj: TObject);
var
ctx: TRttiContext;
objType: TRttiType;
Prop: TRttiProperty;
begin
ctx := TRttiContext.Create;
objType := ctx.GetType(Obj.ClassInfo);
for Prop in objType.GetProperties do begin
if Prop.GetClassType is TClassBase then
// do something special with base class properties
else
// standard functionality on all other properties
end;
end;
The problem is there is no GetClassType for the properties. ClassType just returns TRttiInstancePropertyEx instead of the name of the class to which the property belongs.
Another option is use the Parent property of the TRttiProperty, from here you can access to the class which the property is part of.
{$APPTYPE CONSOLE}
{$R *.res}
uses
Rtti,
SysUtils;
type
TClassBase = class(TObject)
private
FA: Integer;
published
property A: Integer read FA;
end;
TClassDescendant = class(TClassBase)
private
FB: Integer;
published
property B: Integer read FB;
end;
procedure CheckProperties(Obj: TObject);
var
ctx: TRttiContext;
objType: TRttiType;
Prop: TRttiProperty;
begin
ctx := TRttiContext.Create;
objType := ctx.GetType(Obj.ClassInfo);
for Prop in objType.GetProperties do
if TRttiInstanceType(Prop.Parent).MetaclassType=TClassBase then
Writeln(Format('The property %s is declarated in the TClassBase class',[Prop.Name]))
else
Writeln(Format('The property %s is not declarated in the TClassBase class',[Prop.Name]))
end;
begin
try
//CheckProperties(TClassBase.Create);
CheckProperties(TClassDescendant.Create);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
I don't know if it's possible to get the class which a property was introduced, but you can solve your problem with regular RTTI:
begin
...
for Prop in objType.GetProperties do begin
if Assigned(GetPropInfo(TClassBase, Prop.Name)) then
// do something special with base class properties
else
// standard functionality on all other properties
end;
end;
You can use the GetDeclaredProperties method to get properties declarated in the current class and then compare against the values returned by the GetProperties method.
Try this sample.
{$APPTYPE CONSOLE}
{$R *.res}
uses
Rtti,
SysUtils;
type
TClassBase = class(TObject)
private
FA: Integer;
published
property A: Integer read FA;
end;
TClassDescendant = class(TClassBase)
private
FB: Integer;
published
property B: Integer read FB;
end;
procedure CheckProperties(Obj: TObject);
function ExistProp(const PropName:string; List:TArray<TRttiProperty>) : Boolean;
var
Prop: TRttiProperty;
begin
result:=False;
for Prop in List do
if SameText(PropName, Prop.Name) then
begin
Result:=True;
break;
end;
end;
var
ctx: TRttiContext;
objType: TRttiType;
Prop: TRttiProperty;
CurrentClassProps : TArray<TRttiProperty>;
begin
ctx := TRttiContext.Create;
objType := ctx.GetType(Obj.ClassInfo);
CurrentClassProps:=objType.GetDeclaredProperties;
for Prop in objType.GetProperties do
if ExistProp(Prop.Name, CurrentClassProps) then
Writeln(Format('The property %s is declarated in the current %s class',[Prop.Name, obj.ClassName]))
else
Writeln(Format('The property %s is declarated in the base class',[Prop.Name]))
end;
begin
try
//CheckProperties(TClassBase.Create);
CheckProperties(TClassDescendant.Create);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.