События с несколькими слушателями , [Delphi] Два варианта реализации

[--Ins--]

Для осуществления обратной связи в Delphi предусмотрен механизм событий - вызывающий код может обратиться к внешней среде для уведомления о действии, для запроса выполнения некоторых действий или для уточнения параметров. Все бы хорошо, но стандартный механизм событий в Delphi реализует отношение один-к-одному, а иногда удобно иметь один-ко-многим, т.е. чтобы объект смог уведомлять сразу нескольких подключенных к нему слушателей.
Для решения этой задачи в Delphi я использую два различных механизма. Один предполагает реализацию классического паттерна Observer, когда класс регистрирует интерфейсы уведомления своих слушателей, а второй напоминает механизм Multicast-делегатов .NET. Первый способ удобно использовать в тех случаях, когда различных событий много и слушателю как правило нужны все или почти все они, а не лишь несколько. Второй - когда слушателя как правило интересуют лишь некоторые из событий.

1. Паттерн "Observer" (наблюдатель)
Для примера представим, что у нас есть объект, который должен уведомлять своих слушателей о событиях, допустим, Changing и Changed. Для того, чтобы реализовать уведомление нескольких слушателей об этих событий нужно:
1. Объявить интерфейс слушателя
2. Реализовать в объекте, возбуждающем события, механизм управления слушателями
3. Реализовать в классах слушателях интерфейс слушателя
4. Подключить слушатели к объекту
Итак, объявим интерфейс

IMyObserver = interface
  ['{93A613C8-5346-490F-B985-262AEB251355}']
  procedure ObjectChanging(AObject: TMyObject);
  procedure ObjectChanged(AObject: TMyObject);
end;

Методы ObjectChanging/ObjectChanged - это те методы, которые должен реализовать слушатель и которые будет вызывать объект, инициирующий события (TMyObject).
Для управления слушателями в классе TMyObject реализуем несколько методов:

TMyObject = class
private
  FObservers: TInterfaceList;
protected
  // Методы, возбуждающие события
  procedure Changing;
  procedure Changed;
public
  constructor Create;
  destructor Destroy; override;
  // Управление слушателями
  procedure RegisterObserver(const AObserver: IMyObserver);
  procedure UnRegisterObserver(const AObserver: IMyObserver);
end;
 
implementation
 
constructor TMyObject.Create;
begin
  inherited;
  FObservers := TInterfaceList.Create;
end;
 
destructor TMyObject.Destroy;
begin
  FObservers.Free;
  inherited;
end;
 
procedure TMyObject.Changing;
var
  i: Integer;
  Obs: IMyObserver;
begin
  // Вызываем обработчики события
  for i := 0 to FObservers.Count - 1 do begin
    Obs := FObservers[i] as IMyObserver;
    Obs.Changing(self);
  end;
end;
 
procedure TMyObject.Changed;
var
  i: Integer;
  Obs: IMyObserver;
begin
  // Вызываем обработчики события
  for i := 0 to FObservers.Count - 1 do begin
    Obs := FObservers[i] as IMyObserver;
    Obs.Changed(self);
  end;
end;
 
procedure TMyObject.RegisterObserver(const AObserver: IMyObserver);
begin
  FObservers.Add(AObserver);
end;
 
procedure TMyObject.UnRegisterObserver(const AObserver: IMyObserver);
begin
  FObservers.Remove(AObserver);
end;

Ну и остается только реализовать слушателей и подключить их к нашему объекту. Слушателем можно сделать любой класс (ту же форму), реализовав в нем IMyObserver
Простой пример класса-слушателя

TMyObserver = class(TInterfacedObject, IMyObserver)
public
  procedure ObjectChanging(AObject: TMyObject);
  procedure ObjectChanged(AObject: TMyObject);
end;
 
procedure TMyObserver.ObjectChanging(AObject: TMyObject);
begin
  ShowMessage('ObjectChanging');
end;
 
procedure TMyObserver.ObjectChanged(AObject: TMyObject);
begin
  ShowMessage('ObjectChanged');
end;

Ну и вот код регистрации слушателя:

var
  Obs: IMyObserver;
  Obj: TMyObject;
begin
  Obj := TMyObject.Create;
  Obs := TMyObserver.Create;
  Obj.RegisterObserver(Obs);

Теперь если возбудить событие, для каждого зарегистрированного слушателя будет вызван его интерфейсный метод

2. Делегат
Тем, кто знаком с .NET-ом известно что такое делегат. Для остальных поясним, что это специальный объект, который хранит в себе список методов-обработчиков событий (Handlers), позволяет управлять им (добавлять/удалять методы-обработчики) и вызывать эти методы при наступлении события. Реализация такого объекта в Delphi мне показалось интересной задачей, то, что в итоге получилось - продемонстрировано ниже.

type
  PMethod = ^TMethod;
 
  TEventHandler<EventType> = class(TObject)
  public
    Event: EventType;
    constructor Create(AEvent: EventType);
  end;
 
  THandlerEnumarator<EventType> = class
  private
    FIndex: Integer;
    FList: TObjectList;
  public
    constructor Create(AList: TObjectList);
    function GetCurrent: EventType;
    function MoveNext: Boolean;
    property Current: EventType read GetCurrent;
  end;
 
  // Базовый класс делегата
  TDelegate<EventType> = class(TObject)
  private
    FHandlers: TObjectList;
    function Compare(A, B: EventType): Boolean;
    function FindHandler(Handler: EventType): Integer;
    function GetHandler(Index: Integer): EventType;
    function GetHandlersCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddHandler(Handler: EventType);
    procedure RemoveHandler(Handler: EventType);
    function GetEnumerator: THandlerEnumarator<EventType>;
    property HandlersCount: Integer read GetHandlersCount;
    property Handlers[Index: Integer]: EventType read GetHandler;
  end;
 
implementation
 
{ TDelegate<EventType> }
 
procedure TDelegate<EventType>.AddHandler(Handler: EventType);
begin
  FHandlers.Add(TEventHandler<EventType>.Create(Handler));
end;
 
function TDelegate<EventType>.Compare(A, B: EventType): Boolean;
var
  m1, m2: PMethod;
begin
  // Грязно, знаю, ничего лучше не придумал, увы
  m1 := PMethod(@A);
  m2 := PMethod(@B);
  Result := (m1^.Code = m2^.Code) and (m1^.Data = m2^.Data);
end;
 
constructor TDelegate<EventType>.Create;
begin
  inherited;
  FHandlers := TObjectList.Create(True);
end;
 
destructor TDelegate<EventType>.Destroy;
begin
  FHandlers.Free;
  inherited;
end;
 
function TDelegate<EventType>.FindHandler(Handler: EventType): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to HandlersCount - 1 do
    if Compare(Handler, Handlers[i]) then begin
      FHandlers.Delete(i);
      Break;
    end;
end;
 
function TDelegate<EventType>.GetEnumerator: THandlerEnumarator<EventType>;
begin
  Result := THandlerEnumarator<EventType>.Create(FHandlers);
end;
 
function TDelegate<EventType>.GetHandler(Index: Integer): EventType;
begin
  Result := TEventHandler<EventType>(FHandlers[Index]).Event;
end;
 
function TDelegate<EventType>.GetHandlersCount: Integer;
begin
  Result := FHandlers.Count;
end;
 
procedure TDelegate<EventType>.RemoveHandler(Handler: EventType);
var
  Index: Integer;
begin
  Index := FindHandler(Handler);
  if Index >= 0 then
    FHandlers.Delete(Index);
end;
 
{ TEventHandler<EventType> }
 
constructor TEventHandler<EventType>.Create(AEvent: EventType);
begin
  inherited Create;
  Event := AEvent;
end;
 
{ THandlerEnumarator<EventType> }
 
constructor THandlerEnumarator<EventType>.Create(AList: TObjectList);
begin
  inherited Create;
  FIndex := -1;
  FList := AList;
end;
 
function THandlerEnumarator<EventType>.GetCurrent: EventType;
begin
  Result := TEventHandler<EventType>(FList[FIndex]).Event;
end;
 
function THandlerEnumarator<EventType>.MoveNext: Boolean;
begin
  Result := FIndex < FList.Count - 1;
  if Result then
    Inc(FIndex);
end;

Пользоваться теперь таким делегатом не сложнее чем обычными событиями. Допустим мы хотим реализовать событие с множеством слушателей типа TNotifyEvent. Объявим класс делегата:

TNotifyEventDelegate = class(TDelegate<TNotifyEvent>);

Тип можно и не объявлять, а использовать вместо TNotifyEventDelegate подстановку TDelegate<TNotifyEvent>, но я предпочел объявить.
Вместо привычного поля типа TNotifyEvent для события создадим в классе поле типа TNotifyEventDelegate:

  TForm1 = class(TForm)
  private
    { Private declarations }
    FClickEvent: TNotifyEventDelegate;
  public
    { Public declarations }
    property ClickEvent: TNotifyEventDelegate read FClickEvent;
  end;

Для примера создадим пару обработчиков и добавим их в список делегата:

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FClickEvent: TNotifyEventDelegate;
    procedure Handler1(Sender: TObject);
    procedure Handler2(Sender: TObject);
  public
    { Public declarations }
    property ClickEvent: TNotifyEventDelegate read FClickEvent;
  end;
 
implementation
 
{$R *.dfm}
 
procedure TForm2.FormCreate(Sender: TObject);
begin
  FClickEvent := TNotifyEventDelegate.Create;
  FClickEvent.AddHandler(Handler1);
  FClickEvent.AddHandler(Handler2);
end;
 
procedure TForm2.Handler1(Sender: TObject);
begin
  ShowMessage('Handler 1');
end;
 
procedure TForm2.Handler2(Sender: TObject);
begin
  ShowMessage('Handler 2');
end;

Ну и наконец - код, который инициирует событие - очень просто, если в обычных обработчиках мы бы написали

if Assigned(FOnClick) then FOnClick(Self)

То здесь нужно написать так:

procedure TForm1.FormClick(Sender: TObject);
var
  EventHandler: TNotifyEvent;
begin
  for EventHandler in FClickEvent do EventHandler(Sender);
end;

Вуаля! При щелчке на форме появится два сообщения - это сработали два наших обработчика.

На этом все Комментарии/пожелания приветствуются

Сообщение отредактировано: --Ins-- - 16.02.12, 10:39

[Fr0sT]

А я бы сделал подобие JavaScript-овского event bubbling - связанный список обработчиков, по которым поднимается событие. Тогда будет что-то вроде

NotifyBubbler: EventBubbler<TNotifyEvent>;
SomeObject.OnNotifyEvent := NotifyBubbler.Handler;
NotifyBubbler.AddEventListener(SomeListenerObject.NotifyEventHandler);

Добавлено 16.02.12, 18:56
P.S. В принципе, это почти то же самое, что и делегаты. Я думал добавить еще возможность отмены всплытия события, но это тут никуда не засунешь: если добавить параметр в обработчики, то все типы перекосятся.

Сообщение отредактировано: Fr0sT - 16.02.12, 18:56

[--Ins--]

Цитата

Я думал добавить еще возможность отмены всплытия события, но это тут никуда не засунешь: если добавить параметр в обработчики, то все типы перекосятся.

Как вариант - это Abort, но нужно для этого try..except(on EAbort - гасим исключение) в вызов обработчиков вставлять... Куда бы это засунуть чтобы не вставлять вручную....

Сообщение отредактировано: --Ins-- - 16.02.12, 20:35

[ViktorXP]

Довольно странный поиск. или так и задумывалось?

Цитата --Ins-- @ 16.02.12, 10:23

function TDelegate<EventType>.FindHandler(Handler: EventType): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to HandlersCount - 1 do
    if Compare(Handler, Handlers[i]) then begin
      FHandlers.Delete(i);
      Break;
    end;
end;

Цитата --Ins-- @ 16.02.12, 10:23

function TDelegate<EventType>.Compare(A, B: EventType): Boolean;
var
  m1, m2: PMethod;
begin
  // Грязно, знаю, ничего лучше не придумал, увы
  m1 := PMethod(@A);
  m2 := PMethod(@B);
  Result := (m1^.Code = m2^.Code) and (m1^.Data = m2^.Data);
end;

А если так:

function TDelegate<EventType>.Compare(A, B: EventType): Boolean;
begin
  Result := CompareMem(@A, @B, SizeOf(EventType));
end;

[ViktorXP]

а чем TDelegate<EventType> будет отличатся от TList<T> (окромя того что у TDelegate меньше функционала);

[--Ins--]

Цитата ViktorXP @ 19.02.12, 13:56

А если так:

Хм, так не пробовал, компилятор пропускает? Тоже не совсем то чего хотелось бы, если честно, а хотелось бы if a = b

Цитата ViktorXP @ 19.02.12, 16:38

а чем TDelegate<EventType> будет отличатся от TList<T> (окромя того что у TDelegate меньше функционала);

Инкапсуляция. Не из вредности же там меньше функционал, введены только те методы, которые соответствуют данному шаблону поведения. А остальные я бы сказал просто вредны. Объект, интересующийся событием должен уметь только подписаться и отписаться, все остальное строго говоря не его дело.

Да и в принципе я большой противник использования классов типа TList в открытом интерфейсе - эти классы должны быть контейнерами на уровне внутренней логики, а на уровне внешней логики почти всегда должны быть инкапсулированы с предоставлением необходимого логике интерфейса доступа. Как пример - дочерние компоненты в VCL: тебе же дочерние компоненты не в виде TList предоставлены, а в виде индексированного свойства и ограниченного числа методов работы с реальным списком TList, сам же TList скрыт в дебрях внутренней кухни.

[ViktorXP]

Цитата --Ins-- @ 19.02.12, 17:27

Хм, так не пробовал, компилятор пропускает?

да. пропустит. про это как в доке написано так и на своей практике использую.

Цитата --Ins-- @ 19.02.12, 17:27

Тоже не совсем то чего хотелось бы, если честно, а хотелось бы if a = b

так как TMethod имеет размер 8 байт то его можно привести к UInt64/Int64, но это будет не правильно так как в EventType можно положить тип больший/меньший по размеру и что в последствии приведет к ошибке.

[--Ins--]

Цитата ViktorXP @ 19.02.12, 17:53

так как TMethod имеет размер 8 байт то его можно привести к UInt64/Int64, но это будет не правильно так как в EventType можно положить тип больший/меньший по размеру и что в последствии приведет к ошибке.

Не надо так делать, пусть это просто будет очередным примером "сырости" дельфийских дженериков. И ограничение, что тип должен быть метод, сделать не могу, и операция сравнения в пролете

[jack128]

TDelegate<T> не мешало бы наследником TEnumerable<T> сделать

[Shaggy]

Цитата --Ins-- @ 19.02.12, 17:27

Хм, так не пробовал, компилятор пропускает? Тоже не совсем то чего хотелось бы, если честно, а хотелось бы if a = b

TEqualityComparer<EventType>.Default.Equals(A,B)

?

[--Ins--]

Цитата jack128 @ 21.02.12, 08:11

TDelegate<T> не мешало бы наследником TEnumerable<T> сделать

Цитата Shaggy @ 21.02.12, 10:02

TEqualityComparer<EventType>.Default.Equals(A,B)

Угу, согласен