I'm trying to get and set some property values on VCL components. Some are DevExpress and some are not.
I have wrtiten a small helper class:
type
RttiHelper = class
strict private
public
class function GetPropertyValue(const aObject: TObject; const aPropertyName, aSecondLevel: string): TValue; inline;
class function GetPropertyValue2(const aObject: TObject; const aPropertyName, aSecondLevel: string): TValue; inline;
class procedure GetProperty(const aObject: TObject; const aPropertyName, aSecondLevel: string; var aRttiProperty: TRttiProperty); inline;
end;
{ TRttiHelper }
class procedure RttiHelper.GetProperty(const aObject: TObject; const aPropertyName, aSecondLevel: string; var aRttiProperty: TRttiProperty);
var
NextLevel: TObject;
begin
aRttiProperty := TRttiContext.Create.GetType(aObject.ClassType).GetProperty(aPropertyName);
if aRttiProperty = nil then // Try harder: Look after the property in next level
begin
aRttiProperty := TRttiContext.Create.GetType(aObject.ClassType).GetProperty(aSecondLevel);
if aRttiProperty <> nil then
begin
NextLevel := aRttiProperty.GetValue(aObject).AsObject;
if NextLevel = nil then
exit;
aRttiProperty := TRttiContext.Create.GetType(NextLevel.ClassType).GetProperty(aPropertyName);
end;
end;
end;
class function RttiHelper.GetPropertyValue(const aObject: TObject; const aPropertyName, aSecondLevel: string): TValue;
var
RttiProperty: TRttiProperty;
aInstance, Properties: TObject;
begin
RttiProperty := TRttiContext.Create.GetType(aObject.ClassType).GetProperty(aPropertyName);
aInstance := aObject;
if RttiProperty = nil then // Try harder: Look after the property in next level
begin
RttiProperty := TRttiContext.Create.GetType(aObject.ClassType).GetProperty(aSecondLevel);
if RttiProperty <> nil then
begin
Properties := RttiProperty.GetValue(aObject).AsObject;
aInstance := Properties;
if Properties = nil then
exit(nil);
RttiProperty := TRttiContext.Create.GetType(Properties.ClassType).GetProperty(aPropertyName);
end;
end;
if RttiProperty = nil then // Nothing found
exit(nil);
Result := RttiProperty.GetValue(aInstance);
end;
class function RttiHelper.GetPropertyValue2(const aObject: TObject; const aPropertyName, aSecondLevel: string): TValue;
var
RttiProperty: TRttiProperty;
begin
RttiHelper.GetProperty(aObject, aPropertyName, aSecondLevel, RttiProperty);
if RttiProperty <> nil then
Result := RttiProperty.GetValue(aObject)
else
Result := nil;
end;
Preferable I would like to call the GetProperty
method and then get or set the value but on DevExpress Components i dont get the correct result.
Here is how to reproduce:
Place a TEdit
and TcxTextEdit
on a form, and then write the following code:
Edit1.Text := RttiHelper.GetPropertyValue2(Edit1, 'Color', 'Style').AsVariant;
cxTextEdit1.Text := RttiHelper.GetPropertyValue2(cxTextEdit1, 'Color', 'Style').AsVariant;
While if I use this code it wotrks very well:
Edit1.Text := RttiHelper.GetPropertyValue(Edit1, 'Color', 'Style').AsVariant;
cxTextEdit1.Text := RttiHelper.GetPropertyValue(cxTextEdit1, 'Color', 'Style').AsVariant
Can anyone tell me what I'm doing wrong?
The problem is in this line : RttiProperty.GetValue(aObject)
I call GetValue on the the Original object, but it's not certainly that the property is placed on that object.
the property Color e.g is a very good example: On a TEdit it is placed on the "Main Object". You can write Edit1.Color := clBlue;
but in a TcxTextEdit the Color property is placed on a style object, so you'll have to write: cxTextEdit1.Style.Color := clBlue
. There for I need to call RttiProperty.GetValue(aObject)
on the correct object.
In order for doing that I've cahanged the declaration of GetProperty
from
class procedure GetProperty(const aObject: TObject; const aPropertyName, aSecondLevel: string; var aRttiProperty: TRttiProperty);
To:
class procedure GetProperty(var aObject: TObject; const aPropertyName, aSecondLevel: string; var aRttiProperty: TRttiProperty);
An the implementation changed to:
class procedure RttiHelper.GetProperty(var aObject: TObject; const aPropertyName, aSecondLevel: string; var aRttiProperty: TRttiProperty);
var
NextLevel: TObject;
begin
aRttiProperty := ctx.GetType(aObject.ClassType).GetProperty(aPropertyName);
if aRttiProperty = nil then // Try harder: Look after the property in next level
begin
aRttiProperty := ctx.GetType(aObject.ClassType).GetProperty(aSecondLevel);
if aRttiProperty <> nil then
begin
NextLevel := aRttiProperty.GetValue(aObject).AsObject;
if NextLevel = nil then
exit;
aObject := NextLevel;
aRttiProperty := ctx.GetType(NextLevel.ClassType).GetProperty(aPropertyName);
end;
end;
end;
Then it works.
After a bit of cleanup this is my complpete helper:
unit RttiHelperU;
interface
uses
RTTI;
type
RttiHelper = class
strict private
class var ctx: TRttiContext;
public
class function GetProperty(var aObject: TObject; const aPropertyName, aSecondLevel: string): TRttiProperty;
class function GetPropertyValue(aObject: TObject; const aPropertyName, aSecondLevel: string): TValue;
class function SetPropertyValue(aObject: TObject; const aPropertyName, aSecondLevel: string; const aValue: TValue): boolean;
end;
implementation
class function RttiHelper.GetProperty(var aObject: TObject; const aPropertyName, aSecondLevel: string): TRttiProperty;
var
NextLevel: TObject;
begin
Result := ctx.GetType(aObject.ClassType).GetProperty(aPropertyName);
if Result = nil then // Try harder: Look after the property in next level
begin
Result := ctx.GetType(aObject.ClassType).GetProperty(aSecondLevel);
if Result <> nil then
begin
NextLevel := Result.GetValue(aObject).AsObject;
if NextLevel = nil then
exit(nil);
aObject := NextLevel;
Result := ctx.GetType(NextLevel.ClassType).GetProperty(aPropertyName);
end;
end;
end;
class function RttiHelper.GetPropertyValue(aObject: TObject; const aPropertyName, aSecondLevel: string): TValue;
var
RttiProperty: TRttiProperty;
begin
RttiProperty := GetProperty(aObject, aPropertyName, aSecondLevel);
if RttiProperty <> nil then
Result := RttiProperty.GetValue(aObject)
else
Result := nil;
end;
class function RttiHelper.SetPropertyValue(aObject: TObject; const aPropertyName, aSecondLevel: string; const aValue: TValue): boolean;
var
RttiProperty: TRttiProperty;
begin
Result := False;
RttiProperty := GetProperty(aObject, aPropertyName, aSecondLevel);
if RttiProperty = nil then
exit;
try
RttiProperty.SetValue(aObject, aValue);
Result := true;
except
end;
end;
end.