ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Делегирование с расширением
25 сообщений из 26, страница 1 из 2
  1  все
Делегирование с расширением
    #39453987
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Я тут рано порадовался, что в Delphi хорошо написано делегирование. Но не тут-то было...

 
Код: 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.
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  IBaseInterface = interface
  ['{66AAB63F-63FB-47CC-AE2C-1B060EB51E40}']
    procedure DoSomething();
  end;

  TBasicType = class(TInterfacedObject, IBaseInterface)
  private
    procedure DoSomething();
  end;

  IOtherInterface = interface
  ['{2970DD68-0860-4B90-B373-5C18BA8F786D}']
    procedure DoSomethingElse();
  end;

  TDelegate = class(TInterfacedObject, IBaseInterface, IOtherInterface)
  private
    FDelegated : IBaseInterface;
    property Delegated: IBaseInterface read FDelegated implements IBaseInterface;
    procedure DoSomethingElse();
  public
    constructor Create(const ADelegated : IBaseInterface);
  end;

{ TDelegate }

constructor TDelegate.Create(const ADelegated: IBaseInterface);
begin
  FDelegated := ADelegated;
end;

procedure TDelegate.DoSomethingElse;
begin
  Writeln('Something else was done');
end;

{ TBasicType }

procedure TBasicType.DoSomething;
begin
  Writeln('Basics was done');
end;

var
  ABasic, AMiddleMan : IBaseInterface;
  ADelegate : IInterface;
begin
  ABasic := TBasicType.Create;
  ADelegate := TDelegate.Create(ABasic);
  AMiddleMan := ADelegate as IBaseInterface;
  AMiddleMan.DoSomething;
  ReadLn;
  try
    (AMiddleMan as IOtherInterface).DoSomethingElse;
  except
    on E: Exception do
    begin
      Writeln(E.Message);
      ReadLn;
    end;
  end;
    ReadLn;
end.


Нужно чтобы AMiddleMan поддерживал IOtherInterface.
Можно ли как-нибуть этого добиться элегантным образом?
...
Рейтинг: 0 / 0
16.05.2017, 16:56:29
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454012
Uridian
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Uridian
Гость
зеленый админ, так подойдёт?
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
var
  AMiddleMan : IOtherInterface;
begin
  AMiddleMan := TDelegate.Create (TBasicType.Create);
  (AMiddleMan as IBaseInterface).DoSomething;
  ReadLn;
  AMiddleMan.DoSomethingElse;
  ReadLn;
end.
...
Рейтинг: 0 / 0
16.05.2017, 17:32:59
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454020
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Uridian,

нет, увы. Идея в AMiddleMan в том, что он передается в черный ящик как IBaseInterface , но в некоторых коллбеках мне нужно из него распаковать назад IOtherInterface.
...
Рейтинг: 0 / 0
16.05.2017, 17:40:43
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454021
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Я или не тот паттерн юзаю, или еще не понял как правильно работать с TAggregatedObject
...
Рейтинг: 0 / 0
16.05.2017, 17:41:49
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454024
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Kazantsev Alexey
Участник
зеленый админМожно ли как-нибуть этого добиться элегантным образом?
Наследовать TBasicObject от TAggregatedObject?
...
Рейтинг: 0 / 0
16.05.2017, 17:48:43
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454030
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Kazantsev Alexey,

вот видимо. Только я не понимаю, что тогда должно быть контроллером.
...
Рейтинг: 0 / 0
16.05.2017, 17:51:59
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454034
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Kazantsev Alexey
Участник
зеленый админТолько я не понимаю, что тогда должно быть контроллером
То, что реализует IOtherInterface.
...
Рейтинг: 0 / 0
16.05.2017, 17:54:07
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454038
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
зеленый админМожно ли как-нибуть этого добиться элегантным образом?Есть. Обновить Делфи
http://www.sql.ru/forum/1165959/izmenilsya-sposob-vyzova-ekzemplyar-klassa-dlya-queryinterface
...
Рейтинг: 0 / 0
16.05.2017, 17:57:50
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454046
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Kazantsev Alexey,

урра, вышло!

 

Код: 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.
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  IBaseInterface = interface
  ['{66AAB63F-63FB-47CC-AE2C-1B060EB51E40}']
    procedure DoSomething();
  end;

  IOtherInterface = interface
  ['{2970DD68-0860-4B90-B373-5C18BA8F786D}']
    procedure DoSomethingElse();
  end;

  TExtension = class(TInterfacedObject, IOtherInterface)
  private
    procedure DoSomethingElse();
  end;

  TBasicType = class(TAggregatedObject, IBaseInterface)
  private
    procedure DoSomething();
  end;

  TDelegate = class(TInterfacedObject, IBaseInterface)
  private
    FDelegated : TBasicType;
    property Delegated: TBasicType read FDelegated implements IBaseInterface;
  public
    constructor Create(const ADelegated : TBasicType);
  end;

{ TDelegate }

constructor TDelegate.Create(const ADelegated: TBasicType);
begin
  FDelegated := ADelegated;
end;

{ TBasicType }

procedure TBasicType.DoSomething;
begin
  Writeln('Basics was done');
end;

var
  AExtension : TInterfacedObject;
  ABasic : TBasicType;
  AMiddleMan : IBaseInterface;
  ADelegate : IInterface;
{ TExtension }

procedure TExtension.DoSomethingElse;
begin
  Writeln('Something else was done');
end;

begin
  AExtension := TExtension.Create;
  ABasic := TBasicType.Create(AExtension);
  ADelegate := TDelegate.Create(ABasic);
  AMiddleMan := ADelegate as IBaseInterface;
  AMiddleMan.DoSomething;
  ReadLn;
  try
    (AMiddleMan as IOtherInterface).DoSomethingElse;
  except
    on E: Exception do
    begin
      Writeln(E.Message);
      ReadLn;
    end;
  end;
    ReadLn;
end.




всем спасибо!
...
Рейтинг: 0 / 0
16.05.2017, 18:04:45
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454049
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Kazantsev Alexey
Участник
_Vasilisk_Есть. Обновить Делфи
В данном случае это бесполезно.
...
Рейтинг: 0 / 0
16.05.2017, 18:06:08
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454052
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
_Vasilisk_,

Спасибо! познавательно!
...
Рейтинг: 0 / 0
16.05.2017, 18:09:56
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454196
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Kazantsev Alexey_Vasilisk_Есть. Обновить Делфи
В данном случае это бесполезно.

Самое интересное, что обновление оказалось пагубным. Мой исправленный код стал работать в D2007 (именна эта версия сейчас в продакшане), но в XE 10.2 она не работает. Дейсвительно, если в D2007 при выполнении
Код: pascal
1.
(AMiddleMan as IOtherInterface).DoSomethingElse;



использовалась TAggregatedObject.QueryInterface -> TExtension.QueryInterface, то теперь почему-то вызывается TDelegate.QueryInterface. Я так понимаю, это то, про что писал _Vasilisk_ по ссылке выше, но не совсем понял, почему это расценивается как исправление старых ошибок. Конечно, я понимаю, какую цель преследовали те, кто сделал изменения (=неизменение поинтера при вызове QueryInterface), но как-то уж совсем криво выходит. Теперь совсем непонятно, какая роль у TAggregatedObject.
Пока что я оформил это как багу
https://quality.embarcadero.com/browse/RSP-18137.
...
Рейтинг: 0 / 0
16.05.2017, 22:00:47
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454202
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Kazantsev Alexey
Участник
зеленый админто теперь почему-то вызывается TDelegate.QueryInterface
Измени декларацию:
Код: pascal
1.
property Delegated: TBasicType read FDelegated implements IBaseInterface;


на
Код: pascal
1.
property Delegated: IBaseInterface read FDelegated implements IBaseInterface;


И всё будет нормально.
...
Рейтинг: 0 / 0
16.05.2017, 22:18:33
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454213
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Код для обоих версий работает только для аггрегирования через интерфейс. Аггрегирования через класс не работает толком и хз как его сделать нормальным.

 
Код: 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.
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  IBaseInterface = interface
  ['{66AAB63F-63FB-47CC-AE2C-1B060EB51E40}']
    procedure DoSomething();
  end;

  IOtherInterface = interface
  ['{2970DD68-0860-4B90-B373-5C18BA8F786D}']
    procedure DoSomethingElse();
  end;

  TExtension = class(TInterfacedObject, IOtherInterface)
  private
    procedure DoSomethingElse();
  end;

  TBasicType = class(TAggregatedObject, IBaseInterface)
  private
    procedure DoSomething();
  end;

  TDelegate = class(TInterfacedObject, IBaseInterface)
  private
    FDelegated: IBaseInterface;
    property Delegated: IBaseInterface read FDelegated implements IBaseInterface;
  public
    constructor Create(const ADelegated : IBaseInterface);
  end;

{ TDelegate }

constructor TDelegate.Create(const ADelegated: IBaseInterface);
begin
  FDelegated := ADelegated;
end;

{ TBasicType }

procedure TBasicType.DoSomething;
begin
  Writeln('Basics was done');
end;

var
  AExtension : TInterfacedObject;
  ABasic : IBaseInterface;
  AMiddleMan : IBaseInterface;
  ADelegate : IInterface;
{ TExtension }

procedure TExtension.DoSomethingElse;
begin
  Writeln('Something else was done');
end;

begin
  AExtension := TExtension.Create;
  ABasic := TBasicType.Create(AExtension);
  ADelegate := TDelegate.Create(ABasic);
  AMiddleMan := ADelegate as IBaseInterface;
  AMiddleMan.DoSomething;
  try
    (AMiddleMan as IOtherInterface).DoSomethingElse;
  except
    on E: Exception do
    begin
      Writeln(E.Message);
      ReadLn;
    end;
  end;
  ReadLn;
end.


...
Рейтинг: 0 / 0
16.05.2017, 23:03:46
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454278
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kealon(Ruslan)
Участник
зеленый админ,

объясни по русски, что хочешь сделать

ИМХО implements было сделано, что бы облегчить выдачу интерфейсов к объектам не реализующим IUnknown.
Бага до XE2, включительно, в том, что нарушалось правило приоритетов видимости - нельзя было переопределить в агрегирующем объекте методы для указанного в Implements интерфеса. Даже вручную, что как бы нелогично
...
Рейтинг: 0 / 0
17.05.2017, 07:35:54
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454363
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
Kazantsev AlexeyИ всё будет нормально.
Спасибо, сам дошел. Про что и написал. Заметил ваш коммент только сейчас.

kealon(Ruslan)зеленый админ,

объясни по русски, что хочешь сделать

Мы уже все перетерли. Не заморачивайтесь.
...
Рейтинг: 0 / 0
17.05.2017, 09:53:18
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454416
Uridian
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Uridian
Гость
Народ, как избавиться от утечек памяти?

 
текст программы
Код: 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.
program TestDelegation;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  IBaseInterface = interface
    ['{66AAB63F-63FB-47CC-AE2C-1B060EB51E40}']
    procedure DoSomething ();
  end;

  IOtherInterface = interface
    ['{2970DD68-0860-4B90-B373-5C18BA8F786D}']
    procedure DoSomethingElse ();
  end;

  TExtension = class(TInterfacedObject, IOtherInterface)
  private
    procedure DoSomethingElse ();
  end;

  TBasicType = class(TAggregatedObject, IBaseInterface)
  private
    procedure DoSomething ();
  end;

  TDelegate = class(TInterfacedObject, IBaseInterface)
  private
    FDelegated: IBaseInterface;
    property Delegated: IBaseInterface read FDelegated implements IBaseInterface;
  public
    constructor Create (ADelegated: IBaseInterface);
    destructor Destroy; override;
  end;

  { TDelegate }

constructor TDelegate.Create (ADelegated: IBaseInterface);
begin
  FDelegated := ADelegated;
end;

destructor TDelegate.Destroy;
begin
  FDelegated := nil;
  inherited;
end;

{ TBasicType }

procedure TBasicType.DoSomething;
begin
  Writeln ('Basics was done');
end;

{ TExtension }

procedure TExtension.DoSomethingElse;
begin
  Writeln ('Something else was done');
end;

var
  AMiddleMan: IBaseInterface;
begin
  ReportMemoryLeaksOnShutdown := True;
  AMiddleMan := TDelegate.Create (TBasicType.Create (TExtension.Create));
  AMiddleMan.DoSomething;
  (AMiddleMan as IOtherInterface).DoSomethingElse;
  AMiddleMan := nil;
end.



---------------------------
Unexpected Memory Leak
---------------------------
An unexpected memory leak has occurred. The unexpected small block leaks are:
13 - 20 bytes: TDelegate x 1, TBasicType x 1, TExtension x 1
...
Рейтинг: 0 / 0
17.05.2017, 10:48:53
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454483
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
UridianНарод, как избавиться от утечек памяти?
Код: pascal
1.
AMiddleMan := TDelegate.Create (TBasicType.Create(TExtension.Create as IOtherInterface) as IBasicInterface);
...
Рейтинг: 0 / 0
17.05.2017, 11:39:07
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454489
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
зеленый админно не совсем понял, почему это расценивается как исправление старых ошибок.QueryInterface должен обладать свойством симметричности. Т.е. если из интерфейса A можно получить интерфейс B, то и из B можно получить A. Когда все интерфейсы реализовываются через один класс - это выполняется, а когда через implements - операция была односторонней
...
Рейтинг: 0 / 0
17.05.2017, 11:44:36
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454526
Uridian
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Uridian
Гость
_Vasilisk_, ошибка компиляции E2015 Operator not applicable to this operand type (версия XE7)

Код: pascal
1.
TBasicType.Create (TExtension.Create as IOtherInterface) as IBaseInterface
...
Рейтинг: 0 / 0
17.05.2017, 12:16:54
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454529
зеленый админ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
зеленый админ
Участник
_Vasilisk_,

TBasicType ни в каком соку не освобождается... У него же AddRef и Release идет на контроллер - вот только контроллер от силы и освободится. TBasicType нужно освобождать явно.

_Vasilisk_QueryInterface должен обладать свойством симметричности.
Согласен. При изменении поинтера этого не достичь. Раньше если уже пришел в контроллер аггрегата, то оттуда уже не вернешься.
...
Рейтинг: 0 / 0
17.05.2017, 12:18:41
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454593
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Uridianошибка компиляцииПриведите описание конструкторов классов
...
Рейтинг: 0 / 0
17.05.2017, 13:16:39
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454614
Uridian
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Uridian
Гость
"
Код: plaintext
1.
TAggregatedObject provides the functionality for an  inner object  ...
TAggregatedObject  does not itself support any interfaces
"

после чтения документации и практических опытов вывел для себя следующее.

Наследники TAggregatedObject должны храниться внутри Controller-а (или Container-а, кому что нравится) именно как классы, а не как интерфейсы. Их жизненный цикл совпадает с жизненным циклом контейнера, и уничтожаться они должны явно Free.
При этом, несмотря на то, что, неявное (!) приведение наследников TAggregatedObject к интерфейсам, которые они реализуют, почему-то разрешено компилятором, не следует этим пользоваться для хранения их как интерфейсных ссылок внутри контейнера, поскольку это, (в отсутствие явного Free), приводит к утечкам.
...
Рейтинг: 0 / 0
17.05.2017, 13:40:05
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454635
Дельфин131
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дельфин131
Гость
kealon(Ruslan),

А зачем такие сложности, как и где это используется? и зачем? Спасибо
...
Рейтинг: 0 / 0
17.05.2017, 13:56:56
| Ответить | Цитировать | Написать  
Делегирование с расширением
    #39454669
Гаджимурадов Рустам
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гаджимурадов Рустам
Участник
OFF


зеленый админ,

ты Оперой пользуешься что ли?
Отключи кэширование полей.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
17.05.2017, 14:18:18
| Ответить | Цитировать | Написать  
25 сообщений из 26, страница 1 из 2
  1  все
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Делегирование с расширением
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&fpage=144&tid=2042306]:
 0ms
get settings:
 5ms
get forum list:
 10ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 35ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 47ms
get tp. blocked users:
 1ms
others: 226ms
total:  340ms
созд. / загр.: 340ms
x
x
Закрыть


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