Delphi自定义属性实现属性值自动大写及代码异常排查

原问题 #

我查看了一些使用Attributes/Custom Attributes的源码，想了解是否可以通过该特性定义属性值始终为大写，示例代码如下：

TMyObject = class
private
  MyName: string;
published
  [Uppercase]
  MyName: string read FMyName write FMyName;
end;

即不使用Setter过程SetMyName将FMyName转为大写，能否通过attributes实现MyName始终为大写？

更新后的代码问题 #

我尝试了以下代码，请告知该用法是否可行。问题在于IsPropertyUpperCase()始终返回False，我是否哪里写错了？

TUpperCaseAttribute = class(TCustomAttribute)
private
  //
public
  constructor Create;
end;

TMyObject = class
private
  MyName: string;
published
  [Uppercase]
  MyName: string read FMyName write SetMyName;
end;

function IsPropertyUpperCase(aObject: TObject; aPropertyName: string): Boolean;
begin
  Result := False;

  var Context: TRttiContext;
  var RType: TRttiType;
  var Prop: TRttiProperty;
  var LAttr: TCustomAttribute;

  Context := TRttiContext.Create;

  RType := Context.GetType(aObject.ClassType);
  // Code changed here to use the non-iterative method
  Prop := RType.GetProperty(aPropertyName);
  LAttr := Prop.GetAttribute<TUpperCaseAttribute>;
  if LAttr <> nil then
  begin
    Result := True;  
    showmessage(aPropertyName + ' is Uppercase!');
  end;

  // Iterate its properties, including the public ones.
  /*
  for Prop in RType.GetProperties do
  begin
    if CompareText(Prop.Name, aPropertyName) = 0 then
    begin
      for LAttr in Prop.GetAttributes() do
        if LAttr is TUpperCaseAttribute then
        begin
          Result := True;
          Break;
        end;
      Break;
    end;
  end;
  */
  Context.Free;
end;

procedure TMyObject.SetMyName(aValue: string);
begin
  if aValue <> FMyName then
  begin
    { Check RTTI to see if property has "Uppercase" attribute }
    { Is it possible not to loop through each RTTI? }
    if IsPropertyUpperCase(self, 'MyName') then
      FMyName := UpperCase(AValue)
    else
      FMyName := AValue
  end;
end;

问题解答 #

1. 能否不通过Setter直接用属性实现自动大写？ #

不行。Delphi的自定义属性本质是元数据标记，仅用于存储额外信息，不会自动修改属性的读写逻辑。如果属性直接绑定字段（write FMyName），没有Setter方法的话，没有机制能拦截赋值操作并自动转换为大写。必须通过Setter配合RTTI检测属性标记，才能实现自动转换。

2. IsPropertyUpperCase()返回False的原因及修复 #

你的代码存在几个关键错误：

错误1：属性定义不规范

• 私有字段名与属性read/write指定的FMyName不匹配，原代码写的是MyName: string;，需统一为FMyName: string;
• 属性定义遗漏了property关键字，导致无法被正确识别为发布属性，RTTI也无法读取到它

修正后的TMyObject定义：

TMyObject = class
private
  FMyName: string;
published
  [Uppercase]
  property MyName: string read FMyName write SetMyName;
end;

错误2：错误释放TRttiContext

TRttiContext是轻量级对象，其生命周期由Delphi自动管理，手动调用Context.Free;会导致运行时错误，直接删除该行即可。

错误3：自定义属性构造函数未实现

虽然不会直接导致RTTI检测失败，但需补上TUpperCaseAttribute的构造函数实现：

constructor TUpperCaseAttribute.Create;
begin
  inherited;
end;

修正后的IsPropertyUpperCase函数

function IsPropertyUpperCase(aObject: TObject; aPropertyName: string): Boolean;
begin
  Result := False;

  var Context: TRttiContext;
  var RType: TRttiType;
  var Prop: TRttiProperty;
  var LAttr: TUpperCaseAttribute;

  RType := Context.GetType(aObject.ClassType);
  Prop := RType.GetProperty(aPropertyName);
  
  if Prop <> nil then
  begin
    LAttr := Prop.GetAttribute<TUpperCaseAttribute>;
    Result := LAttr <> nil;
    if Result then
      ShowMessage(aPropertyName + ' is Uppercase!');
  end;
end;

3. 性能优化建议 #

每次调用Setter都触发RTTI检测会影响性能，可在对象构造时提前缓存属性标记状态：

TMyObject = class
private
  FMyName: string;
  FMyNameIsUppercase: Boolean;
  procedure SetMyName(aValue: string);
published
  [Uppercase]
  property MyName: string read FMyName write SetMyName;
public
  constructor Create;
end;

constructor TMyObject.Create;
begin
  inherited;
  FMyNameIsUppercase := IsPropertyUpperCase(Self, 'MyName');
end;

procedure TMyObject.SetMyName(aValue: string);
begin
  if aValue <> FMyName then
  begin
    if FMyNameIsUppercase then
      FMyName := UpperCase(aValue)
    else
      FMyName := aValue;
  end;
end;

内容的提问来源于stack exchange，提问作者Peter Jones