Пользовательский атрибут запроса Delphi из интерфейса - PullRequest
Новая
       28

Пользовательский атрибут запроса Delphi из интерфейса

0 голосов
/ 12 марта 2019

Я объявил следующий пользовательский атрибут 

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.

При установке точек останова в конструкторе пользовательских атрибутов код никогда не останавливается. Как я могу получить атрибуты из интерфейса?

1 Ответ

0 голосов
/ 13 марта 2019

На основании комментария Реми Лебо мне удалось решить эту проблему.Имея следующее объявление интерфейса: 

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;

возвращает Атрибут TSpecialAttribute, найденный по значению параметра i IntfAttribute - params

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 - класс

...