Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Указатель на метод интерфейса / 8 сообщений из 8, страница 1 из 1
23.10.2019, 20:53
    #39880679
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
Есть интерфейс с методами одинаковой сигнатуры
Код: pascal
1.
2.
3.
4.
5.
IIntf = interface
  function GetField1: WideString; safecall;
  function GetField2: WideString; safecall;
  function GetField3: WideString; safecall;
end;


и есть класс обертка, который создает экземпляр этого интерфейса, вызывает нужный метод и обрабатывает ошибки
Код: 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.
function TMyClass.GetIntf: IIntf;
begin
  if FIntf = nil then
    FIntf := CreateIntf;
  Result := FIntf;
end;

function TMyClass.GetField1: string;
begin
  try
    Result := GetIntf.GetField1;
  except
    DoExcept;
    Result := 'Default';
  end;
end;

function TMyClass.GetField2: string;
begin
  try
    Result := GetIntf.GetField2;
  except
    DoExcept;
    Result := 'Default';
  end;
end;

function TMyClass.GetField3: string;
begin
  try
    Result := GetIntf.GetField3;
  except
    DoExcept;
    Result := 'Default';
  end;
end;



Хочется убрать повторения реализации TMyClass.GetField. Видится как-то так

Код: 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.
type
  TGetter = function(const AIntf: IIntf): WideString; safecall;

function TMyClass.GetProperty(const AGetter: TGetter): string;
begin
  try
    Result := AGetter(GetIntf);
  except
    DoExcept;
    Result := 'Default';
  end;
end;

function TMyClass.GetField1: string;
begin
  Result := GetProperty(IIntf.GetField1);
end;

function TMyClass.GetField2: string;
begin
  Result := GetProperty(IIntf.GetField2);
end;

function TMyClass.GetField3: string;
begin
  Result := GetProperty(IIntf.GetField3);
end;


конструкцию IIntf.GetField1 компилятор воспринимать отказывается. Есть какое-то решение кроме анонимных функций?

С уважением, Vasilisk
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2019, 21:13
    #39880682
Dmitry Arefiev
Dmitry Arefiev
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
_Vasilisk_
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
function TMyClass.GetProperty(const AGetter: TGetter): string;
begin
  try
    Result := AGetter(GetIntf);
  except
    DoExcept;
    Result := 'Default';
  end;
end;


Это safecall ...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2019, 22:09
    #39880709
alekcvp
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
Dmitry ArefievЭто safecall ...
А разве safecall не наоборот работает, преобразуя HRESULT в EOleSysError?..
https://switch-case.ru/96042
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.10.2019, 12:04
    #39880853
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
Dmitry ArefievЭто safecall ...Во первых нет. Ибоalekcvpнаоборот работает, преобразуя HRESULT в EOleSysError
во-вторых реализация интерфейса мне недоступна
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.10.2019, 14:16
    #39881593
Hammer
Hammer
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
_Vasilisk_во-вторых реализация интерфейса мне недоступна

Ну а сделать наследника интерфейса?
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
  IIntf = interface
    function GetField1: WideString; safecall;
    function GetField2: WideString; safecall;
    function GetField3: WideString; safecall;
  end;

  IIntfHeir = interface(IIntf)
     property Field1: WideString read GetField1;
     property Field2: WideString read GetField2;
     property Field3: WideString read GetField3;
  end;
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.10.2019, 15:04
    #39881616
Hammer
Hammer
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
Поправка на ветер
Код: 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.
type
  IIntf = interface
    function GetField1: WideString; safecall;
    function GetField2: WideString; safecall;
    function GetField3: WideString; safecall;
  end;

  IIntfHeir = interface(IIntf)
    function GetField(Index: Integer): WideString;
    property Field[Index: Integer]: WideString read GetField;
  end;

  function GetIntfHeir: IIntfHeir;

implementation

type
  TIntfHeir = class(TInterfacedObject
                      ,IIntf
                      ,IIntfHeir
                      )
  private
    function GetField1: WideString; safecall;
    function GetField2: WideString; safecall;
    function GetField3: WideString; safecall;
  private
    procedure DoExcept;
  private
    function GetField(Index: Integer): WideString;
  protected
    property Field[Index: Integer]: WideString read GetField;
  end;

function GetIntfHeir: IIntfHeir;
begin
  Result := TIntfHeir.Create;
end;
{ TIntfHeir }

procedure TIntfHeir.DoExcept;
begin
//
end;

function TIntfHeir.GetField(Index: Integer): WideString;
begin
  try
    case Index of
      0: Result := GetField1;
      1: Result := GetField2;
      2: Result := GetField3;
      else
        Result := 'Default';
    end;
  except
    DoExcept;
    Result := 'Default';
  end;
end;

function TIntfHeir.GetField1: WideString;
begin
  Result := 'GetField1';
end;

function TIntfHeir.GetField2: WideString;
begin
  Result := 'GetField2';
end;

function TIntfHeir.GetField3: WideString;
begin
  Result := 'GetField3';
end;

end.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2019, 02:23
    #39881823
Кроик Семён
Кроик Семён
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
_Vasilisk_,

в этом топике куча мыслей. Посмотрите, может в RTTI решение:

https://stackoverflow.com/questions/39584234/how-to-obtain-rtti-from-an-interface-reference-in-delphi
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2019, 18:36
    #39881927
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Указатель на метод интерфейса
Кроик Семёнможет в RTTI решение:Та ну нафиг тащить RTTI из-за такой задачи.

Сделал просто
 
Код: 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.
type
  TGetter = function(const AIntf: IIntf): string;

class function TMyClass.__GetField1(const AIntf: IIntf): string; static;
begin
  Result := AIntf.GetField1;
end;

class function TMyClass.__GetField2(const AIntf: IIntf): string; static;
begin
  Result := AIntf.GetField2;
end;

class function TMyClass.__GetField3(const AIntf: IIntf): string; static;
begin
  Result := AIntf.GetField3;
end;

function TMyClass.GetProperty(const AGetter: TGetter): string;
begin
  try
    Result := AGetter(GetIntf);
  except
    DoExcept;
    Result := 'Default';
  end;
end;

function TMyClass.GetField1: string;
begin
  Result := GetProperty(__GetField1);
end;

function TMyClass.GetField2: string;
begin
  Result := GetProperty(__GetField2);
end;

function TMyClass.GetField3: string;
begin
  Result := GetProperty(__GetField3);
end;

...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Указатель на метод интерфейса / 8 сообщений из 8, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 490ms
Закрыть
start [/forum/topic.php?fid=58&mobile=1&tid=2038907]:
 0ms
get settings:
 10ms
get forum list:
 16ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 146ms
get topic data:
 10ms
get forum data:
 3ms
get page messages:
 49ms
get tp. blocked users:
 2ms
others: 248ms
total:  490ms
x
x
Закрыть


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