ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Указатель на метод интерфейса
8 сообщений из 8, страница 1 из 1
Указатель на метод интерфейса
    #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, 20:53
| Ответить | Цитировать | Написать  
Указатель на метод интерфейса
    #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, 21:13
| Ответить | Цитировать | Написать  
Указатель на метод интерфейса
    #39880709
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Dmitry ArefievЭто safecall ...
А разве safecall не наоборот работает, преобразуя HRESULT в EOleSysError?..
https://switch-case.ru/96042
...
Рейтинг: 0 / 0
23.10.2019, 22:09
| Ответить | Цитировать | Написать  
Указатель на метод интерфейса
    #39880853
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Dmitry ArefievЭто safecall ...Во первых нет. Ибоalekcvpнаоборот работает, преобразуя HRESULT в EOleSysError
во-вторых реализация интерфейса мне недоступна
...
Рейтинг: 0 / 0
24.10.2019, 12:04
| Ответить | Цитировать | Написать  
Указатель на метод интерфейса
    #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, 14:16
| Ответить | Цитировать | Написать  
Указатель на метод интерфейса
    #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
25.10.2019, 15:04
| Ответить | Цитировать | Написать  
Указатель на метод интерфейса
    #39881823
Фотография Кроик Семён
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Кроик Семён
Участник
_Vasilisk_,

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

https://stackoverflow.com/questions/39584234/how-to-obtain-rtti-from-an-interface-reference-in-delphi
...
Рейтинг: 0 / 0
26.10.2019, 02:23
| Ответить | Цитировать | Написать  
Указатель на метод интерфейса
    #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
26.10.2019, 18:36
| Ответить | Цитировать | Написать  
8 сообщений из 8, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Указатель на метод интерфейса
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&gotonew=1&tid=2038907]:
 0ms
get settings:
 6ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 154ms
get topic data:
 7ms
get first new msg:
 4ms
get forum data:
 2ms
get page messages:
 37ms
get tp. blocked users:
 1ms
others: 201ms
total:  432ms
созд. / загр.: 432ms
x
x
Закрыть


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