RTTI 和 DevExpress

Question

我试图在 VCL 组件上获取和设置一些属性值。有些是 DevExpress，有些不是。

我写了一个小帮手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;

最好我想调用 GetProperty 方法然后获取或设置值但是在 DevExpress 组件上我没有得到正确的结果。

重现方法如下：

在窗体上放置一个TEdit和TcxTextEdit，然后编写如下代码：

  Edit1.Text := RttiHelper.GetPropertyValue2(Edit1, 'Color', 'Style').AsVariant;
  cxTextEdit1.Text := RttiHelper.GetPropertyValue2(cxTextEdit1, 'Color', 'Style').AsVariant;

如果我使用这段代码，它会很好地工作：

  Edit1.Text := RttiHelper.GetPropertyValue(Edit1, 'Color', 'Style').AsVariant;
  cxTextEdit1.Text := RttiHelper.GetPropertyValue(cxTextEdit1, 'Color', 'Style').AsVariant

谁能告诉我我做错了什么？

Answer 1

问题出在这一行：RttiProperty.GetValue(aObject) 我在原始对象上调用了 GetValue，但不确定属性是否放在该对象上。

属性颜色例如是一个很好的例子：在 TEdit 上它被放置在 "Main Object" 上。您可以编写 Edit1.Color := clBlue;，但在 TcxTextEdit 中，颜色属性位于样式对象上，因此您必须编写：cxTextEdit1.Style.Color := clBlue。因为我需要在正确的对象上调用 RttiProperty.GetValue(aObject)。

为了做到这一点，我从

中更改了 GetProperty 的声明

class procedure GetProperty(const aObject: TObject; const aPropertyName, aSecondLevel: string; var aRttiProperty: TRttiProperty);

收件人：

class procedure GetProperty(var aObject: TObject; const aPropertyName, aSecondLevel: string; var aRttiProperty: TRttiProperty);

实施更改为：

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;

然后就可以了。

经过一些清理后，这是我的完整帮手：

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.

RTTI 和 DevExpress

RTTI and DevExpress

devexpress

rtti

delphi-xe