Тест

Анонс статьи.

Содержание

• Вместо вступления
• Терминология
• Обработчики событий
• Рассылка событий
• Поведение при освобождении объектов
• Протокол освобождения потомков TSBaseClass
• Оптимизация рассылки событий
• Заключение

Вместо вступления

В 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) расширения функциональности объектов средствами делегирования:

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

Пример

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

Предположим, у нас есть некоторый компонент 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) с дополнительными соглашениями, перечисленными ниже.

Терминология

Событие

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

Определение 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)

класс, содержащий определение методов-обработчиков событий.

Обработчики событий

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

Разновидности обработчиков событий

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

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;

Рассылка событий

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

Способы рассылки событий

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

{ Рассылка события в контексте объекта.
  События можно рассылать с помощью указания пары (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, что прекратит передачу управления обработчикам, установленным ранее текущего. Таким образом обработчик может получить управление до, после и вместо ранее установленных обработчиков.

Поведение при освобождении объектов

Если класс-потомок TSBaseClass, содержащий обработчики событий расширенного делегирования освобождается, его методы-обработчики будут автоматически сняты с соответствующих событий объектов — никаких специальных действий выполнять не требуется.

Тем не менее, допустимо размещать обработчики событий ED в классах, не являющихся потомками TSBaseClass. Но в этом случае, при освобождении экземпляров таких классов, например в деструкторе, потребуется снять все установленные обработчики с соответствующих событий.

Протокол освобождения потомков TSBaseClass

При освобождении объекта-потомка 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.

Оптимизация рассылки событий

В некоторых случаях событие происходит очень часто и возникает потребность в минимизации накладных расходов 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 с исходными текстами.