О расширенном делегировании

В Delphi, как и в большинстве других современных объектно-ориентированных языков существует поддержка делегирования.
Она основана на определении свойств в классах, тип которых — метод объекта с предопределённым интерфейсом. Рассылка события — это обращение к такому свойству как к методу с передачей в него параметров.

Пример

ПоказатьСкрыть

type
  TNotifyEvent = procedure(Sender: TObject) of object;
  ... ... ...
  TStringList = class(TStrings)
  private
    FOnChange: TNotifyEvent;
    ... ... ...
  protected
    procedure Changed; virtual;
    ... ... ...
  public
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    ... ... ...
  end;
... ... ...
procedure TStringList.Changed;
begin
  if (FUpdateCount = 0) and Assigned(FOnChange) then
    FOnChange(Self); // рассылка события
end;

В такой реализации присутствуют ограничения, которые препятствуют применению делегирования для динамического (runtime) расширения функциональности объектов средствами делегирования:

1. В контексте объекта могут происходить только события, описанные в классе. В runtime нет возможности добавить в класс дополнительные свойства, соответственно, нельзя обеспечить рассылку событий, о которых класс «не знает».
2. Архитектурно заложено, что метод-обработчик события может быть только один. В некоторых случаях этого оказывается недостаточно, поэтому приходится прибегать к опасным манипуляциям со ссылками.
   
   Пример

   ПоказатьСкрыть

   Предположим, у нас есть некоторый компонент TComponentExample, содержащий в себе список строк (свойство Items), и обеспечивающий реакцию на его изменение.
   

   type
     TComponentExample = class(TComponent)
     private
       FItems: TStringList;
       procedure OnStringListChanged(Sender: TObject);
       ... ... ...
     public
       property Items: TStringList;
       constructor Create(AStringList: TStringList);
     end;
    
   constructor TComponentExample.Create;
   begin
     ... ... ...
     FStringList := TStringList.Create;
     FStringList.OnChange := OnStringListChanged;
   end;
    
   procedure TComponentExample.OnStringListChanged(Sender: TObject);
   begin
     ... ... ... // Обеспечить реакцию на изменения в Self.Items
   end;
   

   Предположим также, что при использовании этого компонента потребовалось обеспечить дополнительную реакцию на изменение TComponentExample.Items. Если потребность в такой дополнительной реакции возникает достаточно часто при использовании TComponentExample (но не всегда), эту функциональность можно выделить в отдельный класс (THandlerClass - см. ниже). Класс-обработчик THandlerClass может, например, обеспечивать отображение элементов TComponentExample в каком-либо элементе управления, и быть использован в различных контекстах, не только в данном случае, но и в других, когда есть экземпляр TComponentExample и элемент управления, в котором требуется отразить содержимое свойства Items имеющегося экземпляра TComponentExample.
   

   type
     { Этот класс расширяет функциональность TComponentExample и в нём требуется учитывать изменения, происходящие в
       TComponentExample.Items }
     THandlerClass = class
     private
       FControl: TListViewer;
       FComponentExample: TComponentExample;
       FItems_OnChange: TNotifyEvent;
       ... ... ...
     public
       constructor Create(AComponentExample: TComponentExample; AControl: TListViewer);
       procedure OnItemsChanged(Sender: TObject);
       ... ... ...
     end;
    
   constructor THandlerClass.Create(AComponentExample: TComponentExample; AControl: TListViewer);
   begin
     ... ... ...
     FControl := AControl;
     FComponentExample := AComponentExample; // запоминаем ссылку на обрабатываемый объект - она в общем случае нужна
     FItems_OnChange := FComponentExample.OnChange; // запоминаем существующий обработчик ComponentExample.Items.OnChange
     ComponentExample.OnChange := OnStringListChanged; // устанавливаем свой обработчик в ComponentExample.Items.OnChange
   end;
    
   procedure THandlerClass.OnStringListChanged(Sender: TObject);
   begin
     { выполняем необходимые действия после выполнения существующего в TComponentExample обработчика Items.OnChange -
       см. TComponentExample.OnStringListChanged }
     if Assigned(FStringList_OnChange) then
       FStringList_OnChange(Sender);
     ... ... ... 
   end;
   

   Типовое использование THandlerClass может выглядеть примерно так:
   

   type
     TForm1 = class(TForm)
     published
       ListViewer: TListViewer;
       ComponentExample: TComponentExample;
       ... ... ...
     public
       constructor Create(AOwner: TComponent); override;
       ... ... ...
     end;
    
   constructor TForm1.Create(AOwner: TComponent);
   begin
     inherited Create(AOwner);
     FHandlerClass := THandlerClass.Create(ComponentExample, ListViewer);
     ... ... ...
   end;
   

   Если в TForm1 требуется не только отображение содержимого ComponentExample в ListViewer, но и ещё какие-то действия, связанные с изменениями в ComponentExample.Items, то потребуется ещё один метод обработчик, реализованный по той же схеме что и в THandlerClass:
   

   type
     TForm1 = class(TForm)
     private
       FItems_OnChange: TNotifyEvent;
       procedure OnItemsChanged(Sender: TObject);
     published
       ListViewer: TListViewer;
       ComponentExample: TComponentExample;
       ... ... ...
     public
       constructor Create(AOwner: TComponent); override;
       ... ... ...
     end;
    
   constructor TForm1.Create(AOwner: TComponent);
   begin
     inherited Create(AOwner);
     FHandlerClass := THandlerClass.Create(ComponentExample, ListViewer);
     { действия, аналогичные выполненным в THandlerClass.Create: } // [1]
     FItems_OnChange := FComponentExample.OnChange; // запоминаем существующий обработчик ComponentExample.Items.OnChange
     ComponentExample.OnChange := OnItemsChanged; // устанавливаем свой обработчик в ComponentExample.Items.OnChange
     ... ... ...
   end;
    
   procedure TForm1.OnItemsChanged(Sender: TObject);
   begin
     { выполнить требуемые действия до ранее установленных обработчиков }
     ... ... ...
     if Assigned(FStringList_OnChange) then
       FItems_OnChange(Sender); // [2]
   end;
   

   Это будет работать, но после действий в конструкторе TForm1.Create, отмеченных [1], FHandlerClass уже не может быть безопасно освобождён до окончания существования экземпляра TForm1, поскольку, если после освобождения FHandlerClass произойдёт событие ComponentExample.Items.OnChange, строка, отмеченная [2] в общем случае вызовет AccessViolation - ведь метод, адрес которого сохранён в TForm1.FItems_OnChange будет принадлежать уже освобождённому объекту. Конечно же, в данном случае можно всё исправить, обеспечив инициализацию FStringList_OnChange в случае освобождения экземпляра HandlerClass. Но ситуация становится слабоуправляемой, если обработчиков ComponentExample.Items.OnChange станет больше - в конце концов, никто не запретит установить их в других местах, за рамками реализации TForm1. Ещё хуже выглядит то обстоятельство, что в реализации THandlerClass, при его освобождении (в деструкторе например), даже понимая, что его обработчик ComponentExample.Items.OnChange может быть не единственным, нет никакой возможности привести разрываемую цепочку ссылок на обработчики этого события в корректное состояние ввиду того, что в THandlerClass неизвестно, где содержится ссылка на его метод OnStringListChanged. В общем, делегирование в Delphi - это не реализация паттерна Observer, что делает его (делегирования) применение недостаточно гибким, а иногда (как в приведённом примере) - опасным. Возможно, приведённый пример покажется несколько искусственным - это действительно так, он призван проиллюстрировать проблему нескольких обработчиков события делегирования в Delphi. Тем не менее, продемонстрированная техника (запоминания и вызова существующего обработчика события объекта) достаточно часто используется - см. например реализацию метода TJvTreeView.DoMenuChange в модуле JvComCtrls, метода TJvAppEventList.DoActiveControlChange в модуле JvAppEvent из пакета JVCL. Таких примеров - достаточно много.

Расширенное делегирование (ED от Enhanced Delegation), о котором пойдёт речь ниже, устраняет эти ограничения и обеспечивает возможность динамического (в runtime) расширения функциональности объектов, выраженной посредством событий.
Поддержка ED реализована в TSBaseClass, расположенном в модуле Sonar.Core.BaseClass. В этом сообщении рассматривается часть функциональности, обеспечиваемой этим модулем.

Примечание: Ссылка на репозиторий с исходными текстами приводится в конце этого сообщения.

ED вполне можно рассматривать как реализацию шаблона проектирования Наблюдатель (Observer) со следующими дополнительными соглашениями:

1. Терминология:
   
   • Событие (предмет рассылки) представляет собой запись предопределённой структуры, содержащую помимо прочего ссылку на параметры события, которые могут быть использованы в обработчиках.
     Определение TEvent

     ПоказатьСкрыть

     type
       { сведения о событии }
       TEvent = record
         Parms: Pointer;  // параметры
         Done: Boolean;   // признак прекращения рассылки
         Info: TSendInfo; // сведения о состоянии рассылки
       end;
     

   • Рассылка события: процесс передачи управления обработчикам (метод, процедура или замыкание с предопределённым интерфейсом) события, происходящего в контексте какого-либо объекта-потомка TSBaseClass, называемого получателем (Receiver)
   • Идентификатор события: строка, значение которой уникально, желательно для всего приложения. Идентификатор события используется при рассылке для определения списка установленных на событие обработчиков.
     Рекомендуется использовать специальное представление GUID, которое можно получить с помощью специальной программы EventId, выводящей представление GUID, предназначенное для вставки в исходный код на Delphi. В коде идентификаторы событий выглядит, например так:
     
     Примеры идентификаторов событий

     ПоказатьСкрыть

     const
       ev_Terminate = #$5A#$0C#$76#$EA#$B2#$6D#$40#$1B#$B7#$49#$C7#$BF#$BF#$8C#$DB#$9C;
       ev_Finalize = #$56#$D8#$9E#$21#$F9#$2E#$4C#$BA#$97#$32#$DF#$5A#$1C#$29#$9C#$0F;
       ev_EventListChange = #$0E#$2B#$F8#$67#$93#$64#$44#$76#$A1#$DB#$CE#$BD#$96#$5C#$56#$E5;
       ev_Dispatch = #$9A#$4E#$31#$B4#$8D#$85#$45#$55#$B7#$4D#$76#$14#$AD#$C1#$FD#$A7;
     

   • Установка и снятие обработчиков: соответственно, процедуры добавления обработчика в соответствующий список, ассоциированый с идентификатором события в получателе, и исключение обработчика из этого списка.
     Для того, чтобы обработчик получал управление при рассылке события, он должен быть предварительно установлен. Соответственно, после снятия обработчика с события он перестанет получать управление в процессе рассылки события.
   • Класс-обработчик (Handler class): класс, содержащий определение методов-обработчиков событий.
2. В качестве обработчика события могут быть использованы метод, процедура или замыкание (анонимный метод) с предопределённым интерфейсом
   Разновидности обработчиков событий

   ПоказатьСкрыть

   type
     { Типы обработчиков событий объектов: метод, процедура и замыкание.
       Event: сведения о событии
       P в TEventHandlerProc - дополнительный указатель, который можно использовать как контекст }
     TEventHandler = procedure(var Event: TEvent) of object;
     TEventHandlerProc = procedure(P: Pointer; var Event: TEvent);
     TEventHandlerClosure = reference to procedure(var Event: TEvent);
   

   Установка обработчика на событие объекта производится посредством процедуры InstallEventHandler, в которую передаётся объект, в контексте которого предполагается обработка события, идентификатор события и обработчик, относящийся к одной из указанных выше разновидностей. Для прекращения обработки события (снятие обработчика события) используется процедура RemoveEventHandler, её параметры аналогичны параметрам InstallEventHandler.
   Установка и снятие обработчиков событий

   ПоказатьСкрыть

   { Установка обработчика на событие объекта.
     Receiver: объект, в котексте которого будет рассылаться обрабатываемое событие
     EventId: идентификатор события для обработки
     Handler: обработчик одного из трёх типов (см выше)
     Data для TEventHandlerProc: дополнительный указатель, который можно использовать как контекст }
   procedure InstallEventHandler(Receiver: TObject; const EventId: String; Handler: TEventHandler); overload;
   procedure InstallEventHandler(Receiver: TObject; const EventId: String; Handler: TEventHandlerProc; Data: Pointer = nil); overload;
   procedure InstallEventHandler(Receiver: TObject; const EventId: String; Handler: TEventHandlerClosure); overload;
    
   { Снятие обработчика с события объекта.
     Параметры аналогичны InstallEventHandler, поскольку RemoveEventHandler - обратная операция.
     Следует обратить внимание, что в случае использования в качетве обработчика процедуры (TEventHandlerProc), при снятии
     такого обработчика необходимо передавать его контекст (Data), т.е. вызывать процедуру с теми же значениями параметров,
     что и InstallEventHandler. }
   procedure RemoveEventHandler(Receiver: TObject; const EventId: String; Handler: TEventHandler); overload;
   procedure RemoveEventHandler(Receiver: TObject; const EventId: String; Handler: TEventHandlerProc; Data: Pointer = nil); overload;
   procedure RemoveEventHandler(Receiver: TObject; const EventId: String; Handler: TEventHandlerClosure); overload;
   

3. При рассылке события указывается его получатель, идентификатор события (или непосредственная ссылка на список обработчиков — см. далее), ссылка на запись параметров и, опционально, обработчик по-умолчанию.
   Способы рассылки событий

   ПоказатьСкрыть

   { Рассылка события в контексте объекта.
     События можно рассылать с помощью указания пары (Receiver, EventId) или с помощью указания EventInfo, который может быть
     предварительно запрошен посредством GetEventInfo.
     Receiver: объект, в контексте которого рассылается событие.
     EventId: идентификатор рассылаемого события.
     Parms: параметры события.
     EventDone: ссылка на Boolean, в который может быть (если он отличен от nil) занесена информация о том, была ли обработка
       события остановлена в каком-либо обработчике (значение Event.Done).
       Обычно, эта информация не нужна и использовать её настоятельно не рекомендуется.
       Известно единственное её мотивированное применение - маршрутизация событий посредством EventRouter. }
   procedure SendEvent(Receiver: TObject; const EventId: String; Parms: Pointer; EventDone: PBoolean = nil); overload;
   procedure SendEvent(Receiver: TObject; const EventId: String; Parms: Pointer; Default: TEventHandler; EventDone: PBoolean = nil); overload;
   procedure SendEvent(Receiver: TObject; const EventId: String; Parms: Pointer; Default: TEventHandlerProc; Data: Pointer = nil; EventDone: PBoolean = nil); overload;
   procedure SendEvent(Receiver: TObject; const EventId: String; Parms: Pointer; Default: TEventHandlerClosure; EventDone: PBoolean = nil); overload;
   procedure SendEvent(EventInfo: TObject; Parms: Pointer; EventDone: PBoolean = nil); overload;
   procedure SendEvent(EventInfo: TObject; Parms: Pointer; Default: TEventHandler; EventDone: PBoolean = nil); overload;
   procedure SendEvent(EventInfo: TObject; Parms: Pointer; Default: TEventHandlerProc; Data: Pointer = nil; EventDone: PBoolean = nil); overload;
   procedure SendEvent(EventInfo: TObject; Parms: Pointer; Default: TEventHandlerClosure; EventDone: PBoolean = nil); overload;
   

   При рассылке события управление обработчикам передаётся в порядке, обратном порядку их установки. Т.е. последний установленный обработчик события получит управление первым, предпоследний - вторым и т.д. Последним управление получит обработчик по-умолчанию, указываемый при рассылке события. Процедура PassEvent, которая может быть использована только в обработчиках событий, позволяет вызвать все обработчики, установленные до текущего. В случае, если нужно остановить рассылку события, свойству Done записи события (TEvent) следует присвоить значение True.
   
   Пример рассылки события и использования обработчиков различных видов

   ПоказатьСкрыть

   {$apptype console}
    
   program ED_handlers_kinds;
    
   uses
     FastMM4, // MM
     Sonar.Core.BaseClass, // TSBaseClass
     System.SysUtils; // Format
    
   {$region 'TSampleReceiver'}
    
   { Определение объекта, задающего протокол.
     В данном случае протокол тривиален, он сводится к рассылке события ev_SampleReceiver_DoExecute
     в TSampleReceiver.Execute, с передачей параметра этого метода в качестве контекста события. }
   type
     TSampleReceiver = class(TSBaseClass)
     public
       procedure Execute(const AContext: String);
     end;
    
   const
     ev_SampleReceiver_DoExecute = #$6C#$9A#$97#$C5#$95#$4D#$4F#$18#$B8#$6E#$6A#$50#$84#$EF#$F6#$8E;
    
   type
     TEvent_SampleReceiver_DoExecute = record
       Context: String; // контекст события
       DoneTestValue: Boolean; // для проверки прекращения рассылки события
     end;
    
   procedure TSampleReceiver.Execute(const AContext: String);
   var
     parms: TEvent_SampleReceiver_DoExecute;
   begin
     FillChar(parms, SizeOf(parms), 0);
     parms.Context := AContext;
     SendEvent(Self, ev_SampleReceiver_DoExecute, @parms,
       { использование замыканий в качестве обработчиков по-умолчанию, часто очень удобно }
       procedure(var Event: TEvent)
       var
         parms: ^TEvent_SampleReceiver_DoExecute;
       begin
         parms := Event.Parms;
         WriteLn(Format('"%s": default', [parms.Context]));
       end
     );
     WriteLn('-----');
   end;
    
   {$endregion}
    
   {$region 'TSampleHandlerClass'}
    
   type
     TSampleHandlerClass = class(TSBaseClass)
     private
       procedure hnd_SampleReceiver_DoExecute(var Event: TEvent);
     public
       constructor Create(AReceiver: TSampleReceiver);
     end;
    
   constructor TSampleHandlerClass.Create(AReceiver: TSampleReceiver);
   begin
     { Устанавливаем отношение композиции между AReceiver и Self.
       Освобождение AReceiver приведёт к рассылке в его контексте ev_Terminate и активизации
       метода TSBaseClass.CloseSelf, выполняющего освобождение объекта }
     InstallEventHandler(AReceiver, ev_Terminate, CloseSelf);
    
     { Устанавливаем обработчик интересующего события в AReceiver }
     InstallEventHandler(AReceiver, ev_SampleReceiver_DoExecute, hnd_SampleReceiver_DoExecute);
   end;
    
   procedure TSampleHandlerClass.hnd_SampleReceiver_DoExecute(var Event: TEvent);
   var
     parms: ^TEvent_SampleReceiver_DoExecute;
   begin
     parms := Event.Parms;
     Write(Format('"%s": TSampleHandlerClass.hnd_SampleReceiver_DoExecute', [parms.Context]));
    
     { обработчик прекращает рассылку события, если параметр события Context содержит значение '3' }
     if parms.Context <> '3' then
       WriteLn
     else
       begin
         WriteLn(': рассылка события прекращена.');
         Event.Done := True;
       end;
   end;
    
   {$endregion}
    
   { Демонстрация обработчика-процедуры }
   procedure hnd_SampleReceiver_DoExecute_Proc(P: Pointer; var Event: TEvent);
   var
     parms: ^TEvent_SampleReceiver_DoExecute;
     prompt: String;
   begin
     parms := Event.Parms;
     prompt := Format('"%s": hnd_SampleReceiver_DoExecute_Proc: ', [parms.Context]);
     WriteLn(prompt + 'before');
     PassEvent(Event);
     WriteLn(prompt + 'after');
   end;
    
   procedure Execute;
   var
     receiver: TSampleReceiver;
   begin
     { создаём объект, в контексте которого будет выполняться рассылка событий }
     receiver := TSampleReceiver.Create;
     try
       { убеждаемся, что обработчик по-умолчанию выполняется }
       receiver.Execute('1');
    
       { устанавливаем обработчики всех известных типов: метод, процедура и замыкание }
       TSampleHandlerClass.Create(receiver);
       InstallEventHandler(receiver, ev_SampleReceiver_DoExecute, hnd_SampleReceiver_DoExecute_Proc);
       InstallEventHandler(receiver, ev_SampleReceiver_DoExecute,
         { демонстрация обработчика-замыкания }
         procedure(var Event: TEvent)
         var
           parms: ^TEvent_SampleReceiver_DoExecute;
           prompt: String;
         begin
           parms := Event.Parms;
           prompt := Format('"%s": closure handler: ', [parms.Context]);
           WriteLn(prompt + 'before');
           PassEvent(Event);
           WriteLn(prompt + 'after');
         end
       );
    
       { убеждаемся, что обработчики получают управление в ожидаемой последовательности }
       receiver.Execute('2');
    
       { убеждаемся, что в данном случае рассылка события остановлена и обработчик по-умолчанию не получил управление }
       receiver.Execute('3');
     finally
       receiver.Free;
     end;
   end;
    
   begin
     try
       Execute;
     except
       on E: Exception do
         Writeln(E.ClassName, ': ', E.Message);
     end;
     ReadLn;
   end.
   

   Передача управления в порядке, обратном порядку установки обработчиков на событие, и возможность использования в обработчиках процедуры PassEvent, позволяет говорить о динамическом полиморфизме функциональности объекта, выраженной событиями. Действительно:
   • Обработчик по-умолчанию соответствует виртуальному методу базового класса
   • Любой установленный обработчик будет соответствовать его перекрытию в классе-потомке
   • Вызов PassEvent в обработчике соответствует вызову метода предка (inherited) в перекрытой версии этого метода в потомке
   Использование PassEvent даёт возможность разместить функциональность до или после вызова метода унаследованной динамически функциональности (соответственно, до и после вызова PassEvent). Наконец, вызов метода предка можно подавить, установив Event.Done в значение True, что прекратит передачу управления обработчикам, установленным ранее текущего. Таким образом обработчик может получить управление до, после и вместо ранее установленных обработчиков.
4. Если класс-потомок TSBaseClass, содержащий обработчики событий расширенного делегирования освобождается, его методы-обработчики будут автоматически сняты с соответствующих событий объектов — никаких специальных действий выполнять не требуется.
   Тем не менее, допустимо размещать обработчики событий ED в классах, не являющихся потомками TSBaseClass. Но в этом случае, при освобождении экземпляров таких классов, например в деструкторе, потребуется снять все установленные обработчики с соответствующих событий.
5. При освобождении объекта-потомка TSBaseClass в его контексте последовательно происходят два события - ev_Terminate и ev_Finalize.
   • ev_Terminate рассылается до вызова деструктора - точнее, в перекрытом BeforeDestruction, по этой причине в потомках TSBaseClass перекрытие BeforeDestruction не допускается, этот метод объявлен как final. При необходимости выполнить действия до вызова деструктора, следует перекрывать специально объявленный в TSBaseClass виртуальный метод DoBeforeDestruction.
     В момент рассылки ev_Terminate объект ещё сохраняет работоспособность. Обработка этого события обычно связана с завершающими действиями с объектом - например, это событие можно связать с методом CloseSelf, также объявленном в TSBaseClass, выполняющим освобождение объекта-обработчика (см. предыдущий пример - соответствующие действия выполняются в TSampleHandlerClass.Create).
   • ev_Finalize происходит уже в деструкторе TSBaseClass. Обработка этого события может применяться аналогично ev_Terminate (закрытие объектов-обработчиков, для которых объект, в контексте которого рассылаются обрабатываемые ими события, является в сущности владельцем). Главное отличие состоит в том, что если объект-обработчик освобождается на ev_Terminate владельца, он не сможет обрабатывать события, которые могут происходить в его деструкторе. Если отложить закрытие объекта-обработчика на момент ev_Terminate, такие события могут быть им обработаны.
   Демонстрация передачи управления при освобождении объектов-потомков TSBaseClass

   ПоказатьСкрыть

   {$apptype console}
    
   program Terminate_events;
    
   uses
     FastMM4, // MM
     Sonar.Core.BaseClass, // TSBaseClass
     System.SysUtils; // Format
    
   type
     TTestTerminate = class(TSBaseClass)
     public
       // BeforeDestruction объявлен как final в базовом классе, поэтому перекрыть его нельзя.
       // Вместо этого следует перекрывать DoBeforeDestruction, специально предназначенный на замену.
       // procedure BeforeDestruction; override;
       procedure DoBeforeDestruction; override;
       destructor Destroy; override;
     end;
    
   const
     ev_TestTerminate_Flush = #$E6#$4D#$A1#$06#$A5#$B5#$4D#$6E#$91#$03#$EA#$DA#$69#$0C#$E9#$5B;
    
   procedure TTestTerminate.DoBeforeDestruction;
   begin
     WriteLn('DoBeforeDestruction');
     inherited;
   end;
    
   destructor TTestTerminate.Destroy;
   begin
     SendEvent(Self, ev_TestTerminate_Flush, nil,
       procedure(var Event: TEvent)
       begin
         WriteLn('Flush.Default');
       end);
     inherited;
   end;
    
   type
     TTestTerminateHandler = class(TSBaseClass)
     private
       procedure hnd_TestTerminate_Flush(var Event: TEvent);
       procedure hnd_TestTerminate_Finalize(var Event: TEvent);
       procedure hnd_TestTerminate_Terminate(var Event: TEvent);
     public
       constructor Create(ATestTerminate: TTestTerminate);
     end;
    
   constructor TTestTerminateHandler.Create(ATestTerminate: TTestTerminate);
   begin
     { На событие ev_Finalize обычно устанавливается обработчик CloseSelf. Действительно, с объектом, в контексте которого
       получено это событие, уже практически ничего нельзя сделать. Установка специального обработчика выполняется
       исключительно для визуализации рассылки этого события. Те же цели преследует установка обработчика на событие
       ev_Terminate. Обработчик специального события ev_TestTerminate_Flush иллюстрирует получение управления между
       моментом начала освобождения объекта (ev_Terminate) и до конца его жизненного цикла (ev_Finalize). }
     InstallEventHandler(ATestTerminate, ev_Finalize, hnd_TestTerminate_Finalize);
     InstallEventHandler(ATestTerminate, ev_Terminate, hnd_TestTerminate_Terminate);
     InstallEventHandler(ATestTerminate, ev_TestTerminate_Flush, hnd_TestTerminate_Flush);
   end;
    
   procedure TTestTerminateHandler.hnd_TestTerminate_Finalize(var Event: TEvent);
   begin
     WriteLn('Finalize');
     Self.Free;
   end;
    
   procedure TTestTerminateHandler.hnd_TestTerminate_Flush(var Event: TEvent);
   begin
     WriteLn('Flush.Handler(before)');
     PassEvent(Event);
     WriteLn('Flush.Handler(after)');
   end;
    
   procedure TTestTerminateHandler.hnd_TestTerminate_Terminate(var Event: TEvent);
   begin
     WriteLn('Terminate');
   end;
    
   procedure Execute;
   var
     receiver: TTestTerminate;
   begin
     { Визуализация того, что:
       1. события ev_Terminate и ev_Finalize происходят в нужном порядке.
       2. после ev_Terminate до ev_Finalize можно обрабатывать события, происходящие
          в разрушаемом объекте - например, в его деструкторе }
     receiver := TTestTerminate.Create;
     try
       TTestTerminateHandler.Create(receiver);
     finally
       receiver.Free;
     end;
   end;
    
   begin
     try
       Execute;
     except
       on E: Exception do
         Writeln(E.ClassName, ': ', E.Message);
     end;
     ReadLn;
   end.
   

   В результате запуска этой программы на экране окажется следующее:
   

   Terminate
   DoBeforeDestruction
   Flush.Handler(before)
   Flush.Default
   Flush.Handler(after)
   Finalize
   

   Т.е. сначала рассылается событие ev_Terminate, затем вызывается DoBeforeDestruction, после чего в контексте выполняемого деструктора тестового класса рассылается и обрабатывается событие ev_TestTerminate_Flush, а в самом конце происходит ev_Finalize.
6. В некоторых случаях событие происходит очень часто и возникает потребность в минимизации накладных расходов ED на рассылку. В таких ситуациях можно воспользоваться вторым способом рассылки событий, указав в качестве параметра не пару (Получатель, Идентификатор события), а непосредственно список обработчиков.
   Список обработчиков может быть получен посредством функции GetEventId, в которую передаётся Получатель и идентификатор события. После этого можно воспользоваться одним из overload-вариантов SendEvent, предназначенных для рассылки события списку обработчиков. Такой способ рассылки избавлен от накладных расходов на поиск списка обработчиков по идентификатору события в контексте получателя.
   При использовании этого метода рассылки следует учитывать, что список обработчиков в контексте получателя события появится только после того, как будет установлен хотя бы один обработчик. Далее, если с события снимается единственный обработчик, соответствующий список, в котором он содержался, будет автоматически освобождён. Разумеется, если список обработчиков был получен посредством GetEventInfo в ситуации, когда этот список существовал, после его автоматического освобождения попытка разослать событие используя полученный список приведёт к Access Violation.
   В ED предусмотрен механизм, обеспечивающий актуальность ссылки на список обработчиков события. При появлении списка обработчиков события (установка первого обработчика на событие) и при освобождении этого списка (снятие единственного обработчика) в потомке TSBaseClass происходит рассылка события ev_EventListChange, в обработчике по-умолчанию которой производится вызов виртуального метода EventListChange. Это даёт возможность при необходимости держать всегда актуальный список обработчиков как на уровне получателя (нужно перекрыть метод EventListChange), так и в любом другом объекте (следует обработать событие ev_EventListChange, происходящее в получателе).

   Примечание: Это стандартная техника, в таком случае говорят, что действие (в данном случае вызов EventListChange) обёрнуто событием (в данном случае ev_EventListChange).

   Демонстрация использования TSBaseClass.EventListChange и ev_EventListChange

   ПоказатьСкрыть

   Предположим есть класс TSampleSender, в контексте объектов которого очень часто происходит событие ev_SampleSender_OftenOccuredEvent.
   Для оптимизации процесса рассылки вводится поле FEventInfo_OftenOccuredEvent содержащее ссылку на список обработчиков события ev_SampleSender_OftenOccuredEvent.
   Для того, чтобы поддерживать ссылку в актуальном состоянии, перекрывается виртуальный метод EventListChange.
   Далее, есть класс-обработчик TSampleHandler, занимающийся рассылкой события ev_SampleSender_FromHandlerEvent в связанный с ним объект (ASender, передаётся параметром в конструктор TSampleHandler). Рассылка производится также с помощью указания списка обработчиков, который явно запрашивается в конструкторе. Поскольку используется ссылка на список обработчиков, возникает потребность держать её в актуальном состоянии, но т.к. рассылка события ev_SampleSender_FromHandlerEvent происходит в объект другого класса, перекрытие EventListChange в TSampleHandler не поможет - для этой цели следует обработать событие ev_EventListChange, происходящее в ASender.

   Примечание 1: Код этого примера содержится в модульном тесте (см. test_Sonar_Core_BaseClass.dpr), см. процедуру test_Handlers.DoTest_SendEventFastest.

   Примечание 2: В примере используется функция VerifyStringList, реализацию которой можно посмотреть в модуле Sonar.Tests.VerifyStrings.pas.
   Назначение функции - убедиться, что список строк, передаваемый первым параметром, содержит ожидаемые значения, задаваемые вторым параметром.

   {$region 'DoTest_SendEventFastest'}
    
   {$region 'TSampleSender'}
    
   type
     TSampleSender = class(TSBaseClass)
     private
       FEventInfo_OftenOccuredEvent: TObject;
     public
       procedure EventListChange(const EventId: String; EventInfo: TObject); override;
       procedure Test(ALog: TList<String>);
     end;
    
   const
     { "Очень часто происходящее событие", инициируемое в TSampleSender }
     ev_SampleSender_OftenOccuredEvent = #$80#$3D#$FA#$D5#$A0#$D5#$47#$FF#$92#$B7#$C0#$93#$33#$D3#$B6#$81;
    
   type
     TEvent_SampleSender_OftenOccuredEvent = record
       Log: TList<String>;
     end;
    
   procedure TSampleSender.EventListChange(const EventId: String; EventInfo: TObject);
   begin
     if EventId = ev_SampleSender_OftenOccuredEvent then
       FEventInfo_OftenOccuredEvent := EventInfo;
     inherited;
   end;
    
   procedure TSampleSender.Test(ALog: TList<String>);
   var
     parms: TEvent_SampleSender_OftenOccuredEvent;
   begin
     FillChar(parms, SizeOf(parms), 0);
     parms.Log := ALog;
     SendEvent(FEventInfo_OftenOccuredEvent, @parms,
       procedure(var Event: TEvent)
       begin
         TEvent_SampleSender_OftenOccuredEvent(Event.Parms^).Log.Add('OftenOccuredEvent.default');
       end
     );
   end;
    
   {$endregion}
    
   {$region 'TSampleHandler'}
    
   type
     TSampleHandler = class(TSBaseClass)
     private
       FEventInfo_SampleSender_FromHandlerEvent: TObject;
       procedure hnd_SampleSender_EventListChange(var Event: TEvent);
       procedure hnd_SampleSender_OftenOccuredEvent(var Event: TEvent);
     public
       constructor Create(ASender: TSBaseClass);
     end;
    
   const
     { "Очень часто происходящее событие", инициируемое в классе-обработчике TSampleSender }
     ev_SampleSender_FromHandlerEvent = #$30#$63#$03#$08#$09#$13#$4A#$C9#$96#$ED#$39#$FB#$2D#$95#$5A#$E3;
    
   type
     TEvent_SampleSender_FromHandlerEvent = TEvent_SampleSender_OftenOccuredEvent;
    
   constructor TSampleHandler.Create(ASender: TSBaseClass);
   begin
     inherited Create;
     InstallEventHandler(ASender, ev_Terminate, CloseSelf);
     InstallEventHandler(ASender, ev_EventListChange, hnd_SampleSender_EventListChange);
     InstallEventHandler(ASender, ev_SampleSender_OftenOccuredEvent, hnd_SampleSender_OftenOccuredEvent);
    
     { Запросить список обработчиков - в общем случве это обязательно, поскольку событие будет рассылаться
       не в Self, а в другой объект. Это означает, что обработчик на рассылаемое событие может быть установлен
       до того, как появится объект рассылающий событие. }
     FEventInfo_SampleSender_FromHandlerEvent := GetEventInfo(ASender, ev_SampleSender_FromHandlerEvent);
   end;
    
   procedure TSampleHandler.hnd_SampleSender_EventListChange(var Event: TEvent);
   var
     parms: ^TEvent_EventListChange;
   begin
     parms := Event.Parms;
     if parms.EventId = ev_SampleSender_FromHandlerEvent then
       FEventInfo_SampleSender_FromHandlerEvent := parms.EventInfo;
   end;
    
   procedure TSampleHandler.hnd_SampleSender_OftenOccuredEvent(var Event: TEvent);
   var
     parms: ^TEvent_SampleSender_OftenOccuredEvent;
     sendParms: TEvent_SampleSender_FromHandlerEvent;
   begin
     parms := Event.Parms;
     FillChar(sendParms, SizeOf(sendParms), 0);
     sendParms.Log := parms.Log;
     SendEvent(FEventInfo_SampleSender_FromHandlerEvent, @sendParms,
       procedure(var Event: TEvent)
       begin
         TEvent_SampleSender_FromHandlerEvent(Event.Parms^).Log.Add('FromHandlerEvent.default');
       end
     );
   end;
    
   {$endregion}
    
   procedure hnd_FromHandlerEvent(P: Pointer; var Event: TEvent);
   begin
     TEvent_SampleSender_FromHandlerEvent(Event.Parms^).Log.Add('hnd_FromHandlerEvent');
   end;
    
   procedure DoTest_SendEventFastest;
   var
     log: TList<String>;
     sender: TSampleSender;
     handler: TSampleHandler;
   begin
     log := nil; sender := nil; handler := nil;
     try
       log := TList<String>.Create;
    
       { Убеждаемся, что без обработчиков всё работает }
       log.Clear;
       sender := TSampleSender.Create;
       Contract(sender.FEventInfo_OftenOccuredEvent = nil);
       sender.Test(log);
       VerifyStringList(log, ['OftenOccuredEvent.default']);
    
       { добавляем TSampleHandler }
       log.Clear;
       handler := TSampleHandler.Create(sender);
       Contract(sender.FEventInfo_OftenOccuredEvent <> nil);
       Contract(handler.FEventInfo_SampleSender_FromHandlerEvent = nil);
       sender.Test(log);
       VerifyStringList(log, ['FromHandlerEvent.default', 'OftenOccuredEvent.default']);
    
       { добавляем процедурный обработчик }
       log.Clear;
       InstallEventHandler(sender, ev_SampleSender_FromHandlerEvent, hnd_FromHandlerEvent);
       Contract(sender.FEventInfo_OftenOccuredEvent <> nil);
       Contract(handler.FEventInfo_SampleSender_FromHandlerEvent <> nil);
       sender.Test(log);
       VerifyStringList(log, ['hnd_FromHandlerEvent', 'FromHandlerEvent.default', 'OftenOccuredEvent.default']);
    
       { попробуем убрать источник ev_SampleSender_FromHandlerEvent }
       log.Clear;
       FreeAndNil(handler);
       Contract(sender.FEventInfo_OftenOccuredEvent = nil);
       sender.Test(log);
       VerifyStringList(log, ['OftenOccuredEvent.default']);
    
       { снова построим TSampleHandler и проверим сценарий, когда обработчик рассылаемого им события уже есть }
       log.Clear;
       handler := TSampleHandler.Create(sender);
       Contract(sender.FEventInfo_OftenOccuredEvent <> nil);
       Contract(handler.FEventInfo_SampleSender_FromHandlerEvent <> nil);
       sender.Test(log);
       VerifyStringList(log, ['hnd_FromHandlerEvent', 'FromHandlerEvent.default', 'OftenOccuredEvent.default']);
    
       { теперь удалим процедурный обработчик и убедимся, что всё по-прежнему работает }
       log.Clear;
       RemoveEventHandler(sender, ev_SampleSender_FromHandlerEvent, hnd_FromHandlerEvent);
       Contract(sender.FEventInfo_OftenOccuredEvent <> nil);
       Contract(handler.FEventInfo_SampleSender_FromHandlerEvent = nil);
       sender.Test(log);
       VerifyStringList(log, ['FromHandlerEvent.default', 'OftenOccuredEvent.default']);
     finally
       sender.Free;
       log.Free;
     end;
   end;
    
   {$endregion}
   

В заключении остановимся ещё на одной возможности, предоставляемой в Sonar.Core.BaseClass.
Как следует из изложенного выше, события расширенного делегирования всегда рассылаются в контексте объекта. Т.е. для рассылки события нужен получатель. Как быть в случае, если событием должно быть разослано глобально, в приложение?
Sonar.Core.BaseClass содержит для этой цели специальный синглтон AppEventList, распределяемый в приложении в случае необходимости обработки глобальных событий или событий уровня приложения. Для того, чтобы разослать такое событие достаточно в SendEvent указать AppEventList в качестве получателя.

См. также репозиторий Mercurial с исходными текстами.