Delphi从界面查询自定义属性答案

【问题标题】：Delphi query custom attribute from interfaceDelphi从界面查询自定义属性
【发布时间】：2019-08-02 18:32:47
【问题描述】：

我已经声明了以下自定义属性

unit SpecialAttribute;

interface

type
  TSpecialAttribute = class(TCustomAttribute)
  procedure SetValue(aValue: String);
  public
    FValue: String;
    property Value: String read FValue write SetValue;
    constructor Create(const AValue: String);
  end;

implementation

{ TSpecialAttribute }

constructor TSpecialAttribute.Create(const AValue: String);
begin
  FValue := aValue;
end;

procedure TSpecialAttribute.SetValue(aValue: String);
begin
  FValue := aValue;
end;

end.

并用于装饰如下界面：

unit ITestInterface;

interface

uses
  SpecialAttribute;

type
  ITestIntf = interface(IInvokable)
    [TSpecialAttribute('IntfAttribute')]
    procedure Test;
  end;

implementation

end.

我正在尝试使用 RTTI 从接口获取属性：

unit Unit17;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
    SpecialAttribute,ITestInterface;

  type
    TTestClass = class(TInterfacedObject, ITestIntf)
    [TSpecialAttribute('TestClass')]
       procedure Test;
    end;

  TForm17 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form17: TForm17;

implementation

uses
  Rtti;

{$R *.dfm}

procedure TForm17.FormCreate(Sender: TObject);
var
  LContext: TRttiContext;
  LType: TRttiType;
  LAttr: TCustomAttribute;
begin    
  try
  LContext := TRttiContext.Create;

  LType := LContext.GetType(TypeInfo(ITestIntf)); 

  for LAttr in LType.GetAttributes() do
    if LAttr is TSpecialAttribute then
      Memo1.Lines.Add(TSpecialAttribute(LAttr).FValue)
    else
     Memo1.Lines.Add(LAttr.ClassName);
  finally
    LContext.Free;
  end;
end;


end.

在自定义属性构造函数上设置断点时，代码永远不会停止。如何从界面获取属性？

【问题讨论】：

您将属性应用于接口和实现类的方法，而不是接口/类本身，但您正在查询接口本身的属性。因此，您的备忘录中当然不会出现任何内容，因为您正在查询错误级别的属性。您需要先使用TRttiType.Get(Declared)Methods()枚举接口/对象的方法，然后您可以使用TRttiMethod.GetAttributes()查询每个方法的属性。

标签： delphi rtti delphi-10.1-berlin

【解决方案1】：

根据 Remy Lebeau 的评论，我设法解决了这个问题。具有以下接口声明：

unit ITestInterface;

interface

uses
  SpecialAttribute;

type
 [TSpecialAttribute('IntfAttribute - class')]
  ITestIntf = interface(IInvokable)
  [TSpecialAttribute('IntfAttribute - method')]
    procedure Test([TSpecialAttribute('IntfAttribute - params')]i: Integer);
  end;

implementation

end.

1) 获取修饰方法的属性：

var
  LContext: TRttiContext;
  LType: TRttiType;
  LAttr: TCustomAttribute;
  lMethod: TRttiMethod;
begin
  try
    LContext := TRttiContext.Create;

    LType := LContext.GetType(TypeInfo(ITestIntf));

    for lMethod in LType.GetMethods do
    begin
      for LAttr in lMethod.GetAttributes do
      if LAttr.ClassType = TSpecialAttribute then
      begin
        Memo1.Lines.Add(LAttr.ClassName + ' value ' + TSpecialAttribute(LAttr).Value);
      end
      else
        Memo1.Lines.Add(LAttr.ClassName);
    end;
  finally
    LContext.Free;
  end;

返回 - TSpecialAttribute 值 IntfAttribute - 方法

2) 获取修饰参数的属性：

var
  LContext: TRttiContext;
  LType: TRttiType;
  lMethod: TRttiMethod;
  lParam: TRttiParameter;
  lAttr: TCustomAttribute;
begin
  try
  LContext := TRttiContext.Create;

  LType := LContext.GetType(TypeInfo(ITestIntf));
   for lMethod in LType.GetMethods do
   begin
     for lParam in lMethod.GetParameters do
      for lAttr in lParam.GetAttributes do
      begin
        Memo1.Lines.Add('Attribute ' + lAttr.ClassName + ' found on parameter '+ lParam.Name);
        if lAttr.ClassType = TSpecialAttribute then
          Memo1.Lines.Add( '  value ' + TSpecialAttribute(lAttr).Value);
      end;
   end;
  finally
    LContext.Free;
  end;
end;

返回在参数 i 上找到的属性 TSpecialAttribute 值 IntfAttribute - 参数

3) 获取装饰类的属性

 var
  LContext: TRttiContext;
  LType: TRttiType;
  LAttr: TCustomAttribute;
begin
  try
  LContext := TRttiContext.Create;

  LType := LContext.GetType(TypeInfo(ITestIntf));

  for LAttr in LType.GetAttributes() do
    if LAttr is TSpecialAttribute then
      Memo1.Lines.Add(TSpecialAttribute(LAttr).FValue)
    else
     Memo1.Lines.Add(LAttr.ClassName);
  finally
    LContext.Free;
  end;
end;

返回IntfAttribute - 类

【讨论】：