Search code examples
devexpressdelphi-xertti

RTTI and DevExpress


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?


Solution

  • 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.