-2

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?

Jens Borrisholt
  • 6,174
  • 1
  • 33
  • 67
  • Create a variable (local or even better class var) of type `TRttiContext`. You don't ever need to call `TRttiContext.Create`. The designers of the type were drunk when they added that method. – David Heffernan Feb 26 '15 at 10:12
  • As to the question, can you tell us what happens when you call `GetPropertyValue2`. In what way does it fail? What have you learnt from your debugging? – David Heffernan Feb 26 '15 at 10:14
  • The Result is zero when I ask for the color of cxTextEdit1 no Exceptions – Jens Borrisholt Feb 26 '15 at 10:15

1 Answers1

0

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.
Jens Borrisholt
  • 6,174
  • 1
  • 33
  • 67