воскресенье, 8 июня 2014 г.

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


В 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 с исходными текстами.

3 комментария :

  1. Монументальненько...
    Хорошо описано, но, боюсь, одной статьи для понимания может быть мало. Поздравляю с почином в OpenSource :) Вижу, начали анонимные функции использовать, фолдинг настроили? Жаль нет винды под рукой чтобы поиграться.

    P.S. А FastMM из репа я всё-таки бы удалил - это сторонний продукт.

    ОтветитьУдалить
    Ответы
    1. Виктор, спасибо на добром слове :-)

      «боюсь, одной статьи для понимания может быть мало.»
      -- Да, я понимаю. И готовлю продолжение... :-)

      «начали анонимные функции использовать, фолдинг настроили?»
      -- Ну, если я использую инструмент мэйнстрима (IDE) я должен стараться делать это так, как принято в мэйнстриме :-)

      «А FastMM из репа я всё-таки бы удалил - это сторонний продукт.»
      -- Ну, я же не претендую на его авторство... Там есть два обстоятельства:
      1. FastMM позволяет контролировать утечки памяти, а это - существенная часть модульного теста, который я сделал.
      2. Я там изменил inc-файл FastMM - включил опцию FullDebugMode при появлении отвечающего за эту функцию DLL рядом с исполняемым модулем.

      Но наверное, Вы правы - любой при желании может его (FastMM) скачать, да и работает всё и без него...

      Удалить
  2. Только сейчас дошло - теперь есть возможность мой диплом запустить :) Знаю, правда, что он никому не нужен...

    ОтветитьУдалить