На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! Друзья, соблюдайте, пожалуйста, правила форума и данного раздела:
Данный раздел не предназначен для вопросов и обсуждений, он содержит FAQ-заготовки для разных языков программирования. Любой желающий может разместить здесь свою статью. Вопросы же задавайте в тематических разделах!
• Если ваша статья может быть перенесена в FAQ соответствующего раздела, при условии, что она будет оформлена в соответствии с Требованиями к оформлению статей.
• Чтобы остальным было проще понять, указывайте в описании темы (подзаголовке) название языка в [квадратных скобках]!
Модераторы: Модераторы
  
> События с несколькими слушателями, [Delphi] Два варианта реализации
    Для осуществления обратной связи в Delphi предусмотрен механизм событий - вызывающий код может обратиться к внешней среде для уведомления о действии, для запроса выполнения некоторых действий или для уточнения параметров. Все бы хорошо, но стандартный механизм событий в Delphi реализует отношение один-к-одному, а иногда удобно иметь один-ко-многим, т.е. чтобы объект смог уведомлять сразу нескольких подключенных к нему слушателей.
    Для решения этой задачи в Delphi я использую два различных механизма. Один предполагает реализацию классического паттерна Observer, когда класс регистрирует интерфейсы уведомления своих слушателей, а второй напоминает механизм Multicast-делегатов .NET. Первый способ удобно использовать в тех случаях, когда различных событий много и слушателю как правило нужны все или почти все они, а не лишь несколько. Второй - когда слушателя как правило интересуют лишь некоторые из событий.

    1. Паттерн "Observer" (наблюдатель)
    Для примера представим, что у нас есть объект, который должен уведомлять своих слушателей о событиях, допустим, Changing и Changed. Для того, чтобы реализовать уведомление нескольких слушателей об этих событий нужно:
    1. Объявить интерфейс слушателя
    2. Реализовать в объекте, возбуждающем события, механизм управления слушателями
    3. Реализовать в классах слушателях интерфейс слушателя
    4. Подключить слушатели к объекту
    Итак, объявим интерфейс
    ExpandedWrap disabled
      IMyObserver = interface
        ['{93A613C8-5346-490F-B985-262AEB251355}']
        procedure ObjectChanging(AObject: TMyObject);
        procedure ObjectChanged(AObject: TMyObject);
      end;

    Методы ObjectChanging/ObjectChanged - это те методы, которые должен реализовать слушатель и которые будет вызывать объект, инициирующий события (TMyObject).
    Для управления слушателями в классе TMyObject реализуем несколько методов:
    ExpandedWrap disabled
      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
    Простой пример класса-слушателя
    ExpandedWrap disabled
      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;


    Ну и вот код регистрации слушателя:
    ExpandedWrap disabled
      var
        Obs: IMyObserver;
        Obj: TMyObject;
      begin
        Obj := TMyObject.Create;
        Obs := TMyObserver.Create;
        Obj.RegisterObserver(Obs);


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

    2. Делегат
    Тем, кто знаком с .NET-ом известно что такое делегат. Для остальных поясним, что это специальный объект, который хранит в себе список методов-обработчиков событий (Handlers), позволяет управлять им (добавлять/удалять методы-обработчики) и вызывать эти методы при наступлении события. Реализация такого объекта в Delphi мне показалось интересной задачей, то, что в итоге получилось - продемонстрировано ниже.
    ExpandedWrap disabled
      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. Объявим класс делегата:
    ExpandedWrap disabled
      TNotifyEventDelegate = class(TDelegate<TNotifyEvent>);

    Тип можно и не объявлять, а использовать вместо TNotifyEventDelegate подстановку TDelegate<TNotifyEvent>, но я предпочел объявить.
    Вместо привычного поля типа TNotifyEvent для события создадим в классе поле типа TNotifyEventDelegate:
    ExpandedWrap disabled
        TForm1 = class(TForm)
        private
          { Private declarations }
          FClickEvent: TNotifyEventDelegate;
        public
          { Public declarations }
          property ClickEvent: TNotifyEventDelegate read FClickEvent;
        end;

    Для примера создадим пару обработчиков и добавим их в список делегата:
    ExpandedWrap disabled
        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;


    Ну и наконец - код, который инициирует событие - очень просто, если в обычных обработчиках мы бы написали
    ExpandedWrap disabled
      if Assigned(FOnClick) then FOnClick(Self)

    То здесь нужно написать так:
    ExpandedWrap disabled
      procedure TForm1.FormClick(Sender: TObject);
      var
        EventHandler: TNotifyEvent;
      begin
        for EventHandler in FClickEvent do EventHandler(Sender);
      end;


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

    На этом все :) Комментарии/пожелания приветствуются
    Сообщение отредактировано: --Ins-- -
    Фашисты будущего будут называть себя антифашистами. У. Черчилль
      А я бы сделал подобие JavaScript-овского event bubbling - связанный список обработчиков, по которым поднимается событие. Тогда будет что-то вроде

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

      Добавлено
      P.S. В принципе, это почти то же самое, что и делегаты. Я думал добавить еще возможность отмены всплытия события, но это тут никуда не засунешь: если добавить параметр в обработчики, то все типы перекосятся.
      Сообщение отредактировано: Fr0sT -
      Codero ergo sum
      // Программирую — значит, существую
        Цитата
        Я думал добавить еще возможность отмены всплытия события, но это тут никуда не засунешь: если добавить параметр в обработчики, то все типы перекосятся.


        Как вариант - это Abort, но нужно для этого try..except(on EAbort - гасим исключение) в вызов обработчиков вставлять... Куда бы это засунуть чтобы не вставлять вручную....
        Сообщение отредактировано: --Ins-- -
        Фашисты будущего будут называть себя антифашистами. У. Черчилль
          Довольно странный поиск. ;) или так и задумывалось?
          Цитата --Ins-- @
          ExpandedWrap disabled
            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-- @
          ExpandedWrap disabled
            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;
          А если так:
          ExpandedWrap disabled
            function TDelegate<EventType>.Compare(A, B: EventType): Boolean;
            begin
              Result := CompareMem(@A, @B, SizeOf(EventType));
            end;
          select name, telephone from Girls where age between 20 and 25 and (.)(.) >= 2 order by IQ desc limit 1
            а чем TDelegate<EventType> будет отличатся от TList<T> (окромя того что у TDelegate меньше функционала);
            select name, telephone from Girls where age between 20 and 25 and (.)(.) >= 2 order by IQ desc limit 1
              Цитата ViktorXP @
              А если так:


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

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


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

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

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

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

                так как TMethod имеет размер 8 байт то его можно привести к UInt64/Int64, но это будет не правильно так как в EventType можно положить тип больший/меньший по размеру и что в последствии приведет к ошибке.
                select name, telephone from Girls where age between 20 and 25 and (.)(.) >= 2 order by IQ desc limit 1
                  Цитата ViktorXP @
                  так как TMethod имеет размер 8 байт то его можно привести к UInt64/Int64, но это будет не правильно так как в EventType можно положить тип больший/меньший по размеру и что в последствии приведет к ошибке.


                  Не надо так делать, пусть это просто будет очередным примером "сырости" дельфийских дженериков. И ограничение, что тип должен быть метод, сделать не могу, и операция сравнения в пролете
                  Фашисты будущего будут называть себя антифашистами. У. Черчилль
                    TDelegate<T> не мешало бы наследником TEnumerable<T> сделать
                    Не каждая серая масса имеет что-то общее с мозгом (с) Станислав Ежи Лец
                      Цитата --Ins-- @
                      Хм, так не пробовал, компилятор пропускает? Тоже не совсем то чего хотелось бы, если честно, а хотелось бы if a = b

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

                      ?
                      Что бы ни происходило, убедись, что ты чист. Обращай внимание на следы, результаты дают только чистые операции. Ощутив необходимость, проконтролируй себя и раз, и два. Будь чист, пусть это станет законом.
                        Цитата jack128 @
                        TDelegate<T> не мешало бы наследником TEnumerable<T> сделать

                        Цитата Shaggy @
                        TEqualityComparer<EventType>.Default.Equals(A,B)


                        Угу, согласен
                        Фашисты будущего будут называть себя антифашистами. У. Черчилль
                        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                        0 пользователей:


                        Рейтинг@Mail.ru
                        [ Script Execution time: 0,1598 ]   [ 17 queries used ]   [ Generated: 18.07.18, 04:56 GMT ]