В Delphi, как и в большинстве других современных объектно-ориентированных языков существует поддержка
делегирования.
Она основана на определении свойств в классах, тип которых — метод объекта с предопределённым интерфейсом. Рассылка события — это обращение к такому свойству как к методу с передачей в него параметров.
В такой реализации присутствуют ограничения, которые препятствуют применению делегирования для
динамического (runtime) расширения функциональности объектов средствами делегирования:
Поддержка ED реализована в TSBaseClass, расположенном в модуле Sonar.Core.BaseClass. В этом сообщении рассматривается часть функциональности, обеспечиваемой этим модулем.
Как следует из изложенного выше, события расширенного делегирования всегда рассылаются в контексте объекта. Т.е. для рассылки события нужен получатель. Как быть в случае, если событием должно быть разослано глобально, в приложение?
Sonar.Core.BaseClass содержит для этой цели специальный синглтон AppEventList, распределяемый в приложении в случае необходимости обработки глобальных событий или событий уровня приложения. Для того, чтобы разослать такое событие достаточно в SendEvent указать AppEventList в качестве получателя.
См. также репозиторий Mercurial с исходными текстами.
Она основана на определении свойств в классах, тип которых — метод объекта с предопределённым интерфейсом. Рассылка события — это обращение к такому свойству как к методу с передачей в него параметров.
Пример
ПоказатьСкрыть
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 нет возможности добавить в класс дополнительные свойства, соответственно, нельзя обеспечить рассылку событий, о которых класс «не знает».
- Архитектурно заложено, что метод-обработчик события может быть только один. В некоторых случаях
этого оказывается недостаточно, поэтому приходится прибегать к опасным манипуляциям со
ссылками.
ПримерПоказатьСкрытьПредположим, у нас есть некоторый компонент 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 реализована в 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);
Установка и снятие обработчиков событийПоказатьСкрыть{ Установка обработчика на событие объекта. 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;
Пример рассылки события и использования обработчиков различных видовПоказатьСкрыть{$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 в обработчике соответствует вызову метода предка (inherited) в перекрытой версии этого метода в потомке
- Если класс-потомок TSBaseClass, содержащий обработчики событий расширенного делегирования
освобождается, его методы-обработчики будут автоматически сняты с соответствующих событий объектов
— никаких специальных действий выполнять не требуется.
Тем не менее, допустимо размещать обработчики событий ED в классах, не являющихся потомками 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. - ev_Terminate рассылается до вызова деструктора - точнее, в перекрытом
BeforeDestruction, по этой причине в потомках TSBaseClass перекрытие BeforeDestruction не
допускается, этот метод объявлен как final. При необходимости выполнить действия до вызова
деструктора, следует перекрывать специально объявленный в TSBaseClass виртуальный метод
DoBeforeDestruction.
- В некоторых случаях событие происходит очень часто и возникает потребность в минимизации
накладных расходов 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 содержит для этой цели специальный синглтон AppEventList, распределяемый в приложении в случае необходимости обработки глобальных событий или событий уровня приложения. Для того, чтобы разослать такое событие достаточно в SendEvent указать AppEventList в качестве получателя.
См. также репозиторий Mercurial с исходными текстами.
Монументальненько...
ОтветитьУдалитьХорошо описано, но, боюсь, одной статьи для понимания может быть мало. Поздравляю с почином в OpenSource :) Вижу, начали анонимные функции использовать, фолдинг настроили? Жаль нет винды под рукой чтобы поиграться.
P.S. А FastMM из репа я всё-таки бы удалил - это сторонний продукт.
Виктор, спасибо на добром слове :-)
Удалить«боюсь, одной статьи для понимания может быть мало.»
-- Да, я понимаю. И готовлю продолжение... :-)
«начали анонимные функции использовать, фолдинг настроили?»
-- Ну, если я использую инструмент мэйнстрима (IDE) я должен стараться делать это так, как принято в мэйнстриме :-)
«А FastMM из репа я всё-таки бы удалил - это сторонний продукт.»
-- Ну, я же не претендую на его авторство... Там есть два обстоятельства:
1. FastMM позволяет контролировать утечки памяти, а это - существенная часть модульного теста, который я сделал.
2. Я там изменил inc-файл FastMM - включил опцию FullDebugMode при появлении отвечающего за эту функцию DLL рядом с исполняемым модулем.
Но наверное, Вы правы - любой при желании может его (FastMM) скачать, да и работает всё и без него...
Только сейчас дошло - теперь есть возможность мой диплом запустить :) Знаю, правда, что он никому не нужен...
ОтветитьУдалить