Question

我正在尝试获取并在VCL组件上设置一些属性值。有些是DevExpress，有些则不是。

我有一个小帮手类：

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 Components上我得不到正确的结果。

以下是如何重现：

在表单上放置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，但不一定是属性放在该对象上。

属性Color就是一个很好的例子：在TEdit上它被放置在“主要对象”上。您可以编写Edit1.Color := clBlue;但是在TcxTextEdit中，Color属性被放置在样式对象上，因此您必须编写：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;

然后它有效。

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

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

1 个答案: