ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / RTTI: Interface method (dispid)
12 сообщений из 12, страница 1 из 1
RTTI: Interface method (dispid)
    #39576402
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SOFT FOR YOU
Участник
Мне нужно пронумеровать на уровне языка методы интерфейса, а потом с помощью RTTI получить этот номер. Если это возможно конечно. Разумеется VirtualIndex не подходит, так как он выдаёт порядковый номер метода, а мне нужна произвольная "метка".

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
  {$M+}
  IMyObject = interface
    function GetValue: Integer; dispid 15;
  end;
  {$M-}

procedure TForm1.FormCreate(Sender: TObject);
var
  ctx: TRttiContext;
  lType: TRttiType;
  Method: TRttiMethod;
begin
  Memo1.Lines.Clear;
  ctx := TRttiContext.Create;
  lType := ctx.GetType(TypeInfo(IMyObject));

  for Method in lType.GetMethods do
  begin
    Memo1.Lines.Add(Method.ToString);
  end;
end;
...
Рейтинг: 0 / 0
26.12.2017, 20:50
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576506
AX-Class
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AX-Class
Участник
SOFT FOR YOU,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
unit Unit50;

interface

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

type
  MyAttribute = class(TCustomAttribute)
  public
    ID: Integer;
    constructor Create(AID: Integer);
  end;

{$M+}
  IMyObject = interface
    [MyAttribute(15)]
    function GetValue: Integer;
  end;
{$M-}

  TForm50 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form50: TForm50;

implementation

{$R *.dfm}

procedure TForm50.Button1Click(Sender: TObject);
var
  ctx: TRttiContext;
  lType: TRttiType;
  Method: TRttiMethod;
  Attribute: TCustomAttribute;
begin
  Memo1.Lines.Clear;
  ctx := TRttiContext.Create;
  lType := ctx.GetType(TypeInfo(IMyObject));
  for Method in lType.GetMethods do
    begin
      for Attribute in Method.GetAttributes do
        if Attribute is MyAttribute then
          Memo1.Lines.Add(Method.ToString + ' ' + IntToStr(MyAttribute(Attribute).ID));
    end;
end;

constructor MyAttribute.Create(AID: Integer);
begin
  ID := AID;
end;

end.
...
Рейтинг: 0 / 0
27.12.2017, 08:05
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576522
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SOFT FOR YOU
Участник
AX-Class,

Благодарю!
...
Рейтинг: 0 / 0
27.12.2017, 08:55
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576620
Фотография Virtual Student
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Virtual Student
Участник
Давно хотел использовать атрибуты в своих проектах, да все как-то руки не доходили.

Что-то не получается использовать строковые свойства атрибутов... Точнее получается, но только с типом ShortString. Кто в теме подскажите, может я не так что-то делаю?

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
unit uAttrMain;

interface

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

type
  TCustomAttributeClass = class of TCustomAttribute;

  // декларация атрибута
  Meta = class(TCustomAttribute)
  strict private
    fid: Integer;
    fMetaName: string;
  public
    constructor Create(const aid: Integer; const AMetaName: string);
    property id: Integer read fid;
    property MetaName: string read fMetaName;
  end;

  TfrmMain = class(TForm)
    lMemo: TMemo;
    procedure FormCreate(Sender: TObject);
  private
  public
    procedure Log(const msg: string);
    [Meta(10, 'Тестовый метод')]
    procedure Test;
  end;

function MethodHasAttribute(const AClass: TClass; const MethodName: string; Attr: TCustomAttributeClass): Boolean;
function GetAttribute(const AClass: TClass; const MethodName: string; Attr: TCustomAttributeClass): TCustomAttribute;

var
  frmMain: TfrmMain;

implementation

function MethodHasAttribute(const AClass: TClass; const MethodName: string; Attr: TCustomAttributeClass): Boolean;
var RttiContext: TRttiContext;
    lType: TRttiType;
    Method: TRttiMethod;
    Attribute: TCustomAttribute;
begin
  Result := False;
  RttiContext := TRttiContext.Create;
  lType := RttiContext.GetType(AClass.ClassInfo);
  for Method in lType.GetMethods do begin
    if SameText(Method.Name, MethodName) then
      for Attribute in Method.GetAttributes do
        if Attribute is Attr then begin
          Result := True;
          break;
        end;
  end;
end;

function GetAttribute(const AClass: TClass; const MethodName: string; Attr: TCustomAttributeClass): TCustomAttribute;
var RttiContext: TRttiContext;
    lType: TRttiType;
    Method: TRttiMethod;
    Attribute: TCustomAttribute;
begin
  Result := nil;
  RttiContext := TRttiContext.Create;
  lType := RttiContext.GetType(AClass.ClassInfo);
  for Method in lType.GetMethods do begin
    if SameText(Method.Name, MethodName) then
      for Attribute in Method.GetAttributes do
        if Attribute is Attr then begin
          Result := Attribute;
          break;
        end;
  end;
end;

{$R *.dfm}

{ Meta }

constructor Meta.Create(const aid: Integer; const AMetaName: string);
begin
  fid := aid;
  fMetaName := AMetaName;
end;

{ TfrmMain }

procedure TfrmMain.FormCreate(Sender: TObject);
var Attr: Meta;
begin
  if MethodHasAttribute(TfrmMain, 'Test', Meta) then begin
    Attr := GetAttribute(TfrmMain, 'Test', Meta) as Meta;
    Log('id = ' + Attr.id.ToString + ', MetaName = ' + Attr.MetaName);
  end;
end;

procedure TfrmMain.Log(const msg: string);
begin
  lMemo.Lines.Add(msg);
end;

procedure TfrmMain.Test;
begin
  ShowMessage('Test!');
end;

end.
...
Рейтинг: 0 / 0
27.12.2017, 10:55
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576624
Фотография Virtual Student
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Virtual Student
Участник
В примере выше все будет работать если тип свойства атрибута MethName заменить на ShortString . Типы с переменной длинной строки не работают. А хотелось бы использовать именно их!
...
Рейтинг: 0 / 0
27.12.2017, 10:58
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576678
AX-Class
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AX-Class
Участник
Virtual Student,

Полагаю, что не надо отпускать контекст.

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
unit Unit51;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Rtti, System.RTLConsts;

type
  TCustomAttributeClass = class of TCustomAttribute;

  // декларация атрибута
  Meta = class(TCustomAttribute)
  strict private
    fid: Integer;
    fMetaName: string;
  public
    constructor Create(const aid: Integer; const AMetaName: string);
    property id: Integer read fid;
    property MetaName: string read fMetaName;
  end;

  TfrmMain = class(TForm)
    lMemo: TMemo;

    procedure FormCreate(Sender: TObject);
  private
  public
    procedure Log(const msg: string);
    [Meta(10, 'Тестовый метод')]
    procedure Test;
  end;

function MethodHasAttribute(const AClass: TClass; const MethodName: string;
  Attr: TCustomAttributeClass): Boolean;
function GetAttribute(const AClass: TClass; const MethodName: string; Attr: TCustomAttributeClass)
  : TCustomAttribute;

var
  frmMain: TfrmMain;

implementation

 {$R *.dfm}

var
  RttiContext: TRttiContext;

function MethodHasAttribute(const AClass: TClass; const MethodName: string;
  Attr: TCustomAttributeClass): Boolean;
var
  lType: TRttiType;
  Method: TRttiMethod;
  Attribute: TCustomAttribute;
begin
  Result := False;
  lType := RttiContext.GetType(AClass.ClassInfo);
  for Method in lType.GetMethods do
    begin
      if SameText(Method.Name, MethodName) then
        for Attribute in Method.GetAttributes do
          if Attribute is Attr then
            begin
              Result := True;
              break;
            end;
    end;
end;

function GetAttribute(const AClass: TClass; const MethodName: string; Attr: TCustomAttributeClass)
  : TCustomAttribute;
var
  lType: TRttiType;
  Method: TRttiMethod;
  Attribute: TCustomAttribute;
begin
  Result := nil;
  lType := RttiContext.GetType(AClass.ClassInfo);
  for Method in lType.GetMethods do
    begin
      if SameText(Method.Name, MethodName) then
        for Attribute in Method.GetAttributes do
          if Attribute is Attr then
            begin
              Result := Attribute;
              break;
            end;
    end;
end;

{ Meta }

constructor Meta.Create(const aid: Integer; const AMetaName: string);
begin
  fid := aid;
  fMetaName := AMetaName;
end;

{ TfrmMain }

procedure TfrmMain.FormCreate(Sender: TObject);
var
  Attr: Meta;
begin
  RttiContext := TRttiContext.Create;
  if MethodHasAttribute(TfrmMain, 'Test', Meta) then
    begin
      Attr := GetAttribute(TfrmMain, 'Test', Meta) as Meta;
      Log('id = ' + Attr.id.ToString + ', MetaName = ' + Attr.MetaName);
    end;
  RttiContext.Free;
end;

procedure TfrmMain.Log(const msg: string);
begin
  lMemo.Lines.Add(msg);
end;

procedure TfrmMain.Test;
begin
  ShowMessage('Test!');
end;

end.

...
Рейтинг: 0 / 0
27.12.2017, 11:47
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576692
Фотография Virtual Student
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Virtual Student
Участник
AX-ClassПолагаю, что не надо отпускать контекст.

Да, выходит, что так! Работает почти с любыми типами данных.
Спасибо!
...
Рейтинг: 0 / 0
27.12.2017, 11:54
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576693
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Virtual Student,

Небольшой оффтоп, но зачем вы дублируете код?
Код: pascal
1.
2.
3.
4.
  if MethodHasAttribute(TfrmMain, 'Test', Meta) then begin
    Attr := GetAttribute(TfrmMain, 'Test', Meta) as Meta;
    Log('id = ' + Attr.id.ToString + ', MetaName = ' + Attr.MetaName);
  end;

можно же сделать
Код: pascal
1.
2.
3.
  Attr := GetAttribute(TfrmMain, 'Test', Meta) as Meta;
  if Attr <> nil then 
    Log('id = ' + Attr.id.ToString + ', MetaName = ' + Attr.MetaName);


А так по-сути, лишний цикл выполняется, плюс если вы захотите что-то поменять, то надо синхронизировать изменения в обоих процедурах...
...
Рейтинг: 0 / 0
27.12.2017, 11:54
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576698
Фотография Virtual Student
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Virtual Student
Участник
alekcvpVirtual Student,

Небольшой оффтоп, но зачем вы дублируете код?
Код: pascal
1.
2.
3.
4.
  if MethodHasAttribute(TfrmMain, 'Test', Meta) then begin
    Attr := GetAttribute(TfrmMain, 'Test', Meta) as Meta;
    Log('id = ' + Attr.id.ToString + ', MetaName = ' + Attr.MetaName);
  end;

можно же сделать
Код: pascal
1.
2.
3.
  Attr := GetAttribute(TfrmMain, 'Test', Meta) as Meta;
  if Attr <> nil then 
    Log('id = ' + Attr.id.ToString + ', MetaName = ' + Attr.MetaName);


А так по-сути, лишний цикл выполняется, плюс если вы захотите что-то поменять, то надо синхронизировать изменения в обоих процедурах...
Это не рабочий код, а просто для изучения и понимания.
...
Рейтинг: 0 / 0
27.12.2017, 11:59
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576888
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
X-Cite
Участник
Вброс..
Чтобы не писать каждый раз
Код: pascal
1.
2.
3.
{$M+}
  IMyObject = interface
{$M-}


заменить на
Код: pascal
1.
IMyObject = interface(IInvokable)
...
Рейтинг: 0 / 0
27.12.2017, 15:03
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39576955
AX-Class
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AX-Class
Участник
Virtual StudentAX-ClassПолагаю, что не надо отпускать контекст.

Да, выходит, что так! Работает почти с любыми типами данных.
Спасибо!
Тут не в типах проблема, а в том, что ты обращался к убитому объекту.
Вставь в старый код и увидишь:
Код: pascal
1.
2.
3.
4.
5.
destructor Meta.Destroy;
begin
  frmMain.Log('Meta.Destroy');
  inherited;
end;
...
Рейтинг: 0 / 0
27.12.2017, 16:07
| Ответить | Цитировать | Написать  
RTTI: Interface method (dispid)
    #39577077
ziv-2014
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ziv-2014
Участник
Как получить dispid у функции?
...
Рейтинг: 0 / 0
27.12.2017, 18:49
| Ответить | Цитировать | Написать  
12 сообщений из 12, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / RTTI: Interface method (dispid)
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&msg=39577077&tid=2041400]:
 0ms
get settings:
 8ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 199ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 52ms
get tp. blocked users:
 1ms
others: 225ms
total:  516ms
созд. / загр.: 516ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]