Агрегатор событий - приведение объекта к интерфейсу

Я думаю, что возможным обходным путем является использование неуниверсального интерфейса с GUID:

IMessageHandler = interface
  ['...']
  procedure Handle(const AMessage: TValue);
end;

Чтобы иметь возможность проверить, реализует ли экземпляр данный интерфейс, этот интерфейс должен иметь определенный GUID. Итак, добавьте guid в свой интерфейс (вам также понадобится этот guid в константе или переменной, чтобы вы могли ссылаться на него позже в коде):

const
  IID_Handle: TGUID = '{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}';

type
  IHandle<TMessage> = interface
    ['{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}']
    procedure Handle(AMessage: TMessage);
  end;

(Вы не должны использовать мой guid, это просто пример... нажмите ctrl+shift+G, чтобы сгенерировать новый guid в IDE).

Затем проверьте, поддерживает ли зарегистрированный подписчик этот интерфейс:

//      LTarget:= LReference as IHandle; // <-- Wish this would work
      if Supports(LReference, IID_Handle, LTarget) then
        LTarget.Handle(AMessage);

Однако при этом не учитывается общая часть интерфейса, проверяется только GUID.

Таким образом, вам понадобится дополнительная логика, чтобы проверить, действительно ли цель поддерживает тип сообщения.

Кроме того, поскольку вы имеете дело с классами, которые будут реализовывать интерфейс и, следовательно, должны быть производными от TInterfacedObject (или совместимого интерфейса с этим классом), вы должны сохранить все ссылки на созданный объект в переменных интерфейса, таким образом, изменив список подписчиков с ссылка на TObjects' на один из IInterfaces'. И для этого тоже есть специальный класс:

FSubscribers: TInterfaceList;

Конечно, вам также придется изменить подпись для функций подписки/отписки:

procedure Subscribe(AInstance: IInterface);
procedure Unsubscribe(AInstance: IInterface);

Я думаю, что лучшим способом было бы убрать общий интерфейс IHandle. Таким образом, вы можете обеспечить, чтобы все подписчики реализовали базовый интерфейс IHandler, изменив подпись подписки/отмены подписки, чтобы использовать IHandler вместо IInterface.

Затем IHandler может содержать функциональные возможности, необходимые для определения того, поддерживает ли подписчик данный тип сообщения или нет.

Это будет оставлено читателю в качестве упражнения. Вы можете начать с моего небольшого тестового приложения (D2010), которое можно загрузить с My Тестовое приложение.

Н.Б. Тестовое приложение исследует возможность использования дженериков в интерфейсе и, скорее всего, вылетит при публикации событий. Используйте отладчик для одного шага, чтобы увидеть, что происходит. У меня не происходит сбой при публикации целого числа 0, что, кажется, работает. Причина в том, что обработчики Int и String будут вызываться независимо от типа ввода для публикации (как обсуждалось ранее).

Другой подход состоит в том, чтобы полностью пропустить интерфейсы и перейти к функциям диспетчеризации TObject.

Для этого нам нужна запись сообщения:

  TMessage = record
    MessageId: Word;
    Value: TValue;
  end;

а также некоторые идентификаторы событий:

const
  EVENT_BASE = WM_USER;
  MY_EVENT = EVENT_BASE;
  OTHER_EVENT = MY_EVENT + 1;

и обновите процедуру публикации:

procedure TEventAggregator.Publish<T>(MsgId: Word; const Value: T);
var
  LReference: TObject;
  Msg: TMessage;
begin
  Msg.MessageId := MsgId;
  Msg.Value := TValue.From(Value);

  for LReference in FSubscribers do begin
    LReference.Dispatch(Msg);
  end;
end;

Тогда ЛЮБОЙ объект может быть подписчиком событий. Чтобы обработать событие, обработчику нужно только указать, какой идентификатор события обрабатывать (или перехватывать его в DefaultHandler).

Чтобы обработать сообщение MY_EVENT, просто добавьте это в класс:

procedure HandleMyEvent(var Msg: TMessage); message MY_EVENT;

См. также пример отправки из документации delphi: TObjectDispatch

Таким образом, мы можем публиковать сообщения и позволять подписчику выбирать, какие из них обрабатывать. Также тип можно определить в обработчике. Кроме того, можно объявить (в документации, а не в коде), что данный идентификатор события должен иметь заданный тип, чтобы обработчик события для MY_EVENT мог просто получить доступ к значению как Msg.Value.AsInteger.

Н.Б. Сообщение передается как var, поэтому оно может быть изменено подписчиками. Если это неприемлемо, запись Msg необходимо повторно инициализировать перед каждой отправкой.

Рабочий прототип. В производстве не тестировался!

unit zEventAggregator;

interface

uses
  Classes, TypInfo, SysUtils, Generics.Collections;

type
  /// <summary>
  /// Denotes a class which can handle a particular type of message.
  /// </summary>
  /// <typeparam name="TMessage">The type of message to handle.</typeparam>
  IHandle<TMessage> = interface
    /// <summary>
    /// Handles the message.
    /// </summary>
    /// <param name="message">The message.</param>
    procedure Handle(AMessage: TMessage);
  end;

  /// <summary>
  /// Subscription token
  /// </summary>
  ISubscription = interface
    ['{3A557B05-286B-4B86-BDD4-9AC44E8389CF}']
    procedure Dispose;
    function GetSubscriptionType: string;
    property SubscriptionType: string read GetSubscriptionType;
  end;

  TSubscriber<T> = class(TInterfacedObject, ISubscription)
  strict private
    FAction: TProc<T>;
    FDisposed: Boolean;
    FHandle: IHandle<T>;
    FOwner: TList < TSubscriber < T >> ;
  public
    constructor Create(AOwner: TList < TSubscriber < T >> ; AAction: TProc<T>; AHandle: IHandle<T>);
    destructor Destroy; override;
    procedure Dispose;
    procedure Publish(AMessage: T);
    function GetSubscriptionType: string;
  end;

  TEventBroker<T> = class
  strict private
    FSubscribers: TList < TSubscriber < T >> ;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Publish(AMessage: T);
    function Subscribe(AAction: IHandle<T>): ISubscription; overload;
    function Subscribe(AAction: TProc<T>): ISubscription; overload;
  end;

  TBaseEventAggregator = class
  strict protected
    FEventBrokers: TObjectDictionary<PTypeInfo, TObject>;
  public
    constructor Create;
    destructor Destroy; override;
    function GetEvent<TMessage>: TEventBroker<TMessage>;
  end;

  /// <summary>
  /// Enables loosely-coupled publication of and subscription to events.
  /// </summary>
  TEventAggregator = class(TBaseEventAggregator)
  public
    /// <summary>
    /// Publishes a message.
    /// </summary>
    /// <typeparam name="T">The type of message being published.</typeparam>
    /// <param name="message">The message instance.</param>
    procedure Publish<TMessage>(AMessage: TMessage);
    /// <summary>
    /// Subscribes an instance class handler IHandle<TMessage> to all events of type TMessage/>
    /// </summary>
    function Subscribe<TMessage>(AAction: IHandle<TMessage>): ISubscription; overload;
    /// <summary>
    /// Subscribes a method to all events of type TMessage/>
    /// </summary>
    function Subscribe<TMessage>(AAction: TProc<TMessage>): ISubscription; overload;
  end;

implementation

{ TSubscriber<T> }

constructor TSubscriber<T>.Create(AOwner: TList < TSubscriber < T >> ; AAction: TProc<T>; AHandle: IHandle<T>);
begin
  FAction := AAction;
  FDisposed := False;
  FHandle := AHandle;
  FOwner := AOwner;
end;

destructor TSubscriber<T>.Destroy;
begin
  Dispose;
  inherited;
end;

procedure TSubscriber<T>.Dispose;
begin
  if not FDisposed then
  begin
    TMonitor.Enter(Self);
    try
      if not FDisposed then
      begin
        FAction := nil;
        FHandle := nil;
        FOwner.Remove(Self);
        FDisposed := true;
      end;
    finally
      TMonitor.Exit(Self);
    end;
  end;
end;

function TSubscriber<T>.GetSubscriptionType: string;
begin
  Result:= GetTypeName(TypeInfo(T));
end;

procedure TSubscriber<T>.Publish(AMessage: T);
var
  a: TProc<T>;
begin
  if Assigned(FAction) then
    TProc<T>(FAction)(AMessage)
  else if Assigned(FHandle) then
    FHandle.Handle(AMessage);
end;

{ TEventBroker<T> }

constructor TEventBroker<T>.Create;
begin
  FSubscribers := TList < TSubscriber < T >> .Create;
end;

destructor TEventBroker<T>.Destroy;
begin
  FreeAndNil(FSubscribers);
  inherited;
end;

procedure TEventBroker<T>.Publish(AMessage: T);
var
  LTarget: TSubscriber<T>;
begin
  TMonitor.Enter(Self);
  try
    for LTarget in FSubscribers do
    begin
      LTarget.Publish(AMessage);
    end;
  finally
    TMonitor.Exit(Self);
  end;
end;

function TEventBroker<T>.Subscribe(AAction: IHandle<T>): ISubscription;
var
  LSubscriber: TSubscriber<T>;
begin
  TMonitor.Enter(Self);
  try
    LSubscriber := TSubscriber<T>.Create(FSubscribers, nil, AAction);
    FSubscribers.Add(LSubscriber);
    Result := LSubscriber;
  finally
    TMonitor.Exit(Self);
  end;
end;

function TEventBroker<T>.Subscribe(AAction: TProc<T>): ISubscription;
var
  LSubscriber: TSubscriber<T>;
begin
  TMonitor.Enter(Self);
  try
    LSubscriber := TSubscriber<T>.Create(FSubscribers, AAction, nil);
    FSubscribers.Add(LSubscriber);
    Result := LSubscriber;
  finally
    TMonitor.Exit(Self);
  end;
end;

{ TBaseEventAggregator }

constructor TBaseEventAggregator.Create;
begin
  FEventBrokers := TObjectDictionary<PTypeInfo, TObject>.Create([doOwnsValues]);
end;

destructor TBaseEventAggregator.Destroy;
begin
  FreeAndNil(FEventBrokers);
  inherited;
end;

function TBaseEventAggregator.GetEvent<TMessage>: TEventBroker<TMessage>;
var
  LEventBroker: TObject;
  LEventType: PTypeInfo;
  s: string;
begin
  LEventType := TypeInfo(TMessage);
  s:= GetTypeName(LEventType);

  if not FEventBrokers.TryGetValue(LEventType, LEventBroker) then
  begin
    TMonitor.Enter(Self);
    try
      if not FEventBrokers.TryGetValue(LEventType, LEventBroker) then
      begin
        LEventBroker := TEventBroker<TMessage>.Create;
        FEventBrokers.Add(LEventType, LEventBroker);
      end;
    finally
      TMonitor.Exit(Self);
    end;
  end;

  Result := TEventBroker<TMessage>(LEventBroker);
end;

{ TEventAggregator }

procedure TEventAggregator.Publish<TMessage>(AMessage: TMessage);
begin
  GetEvent<TMessage>.Publish(AMessage);
end;

function TEventAggregator.Subscribe<TMessage>(AAction: IHandle<TMessage>): ISubscription;
begin
  Result := GetEvent<TMessage>.Subscribe(AAction);
end;

function TEventAggregator.Subscribe<TMessage>(AAction: TProc<TMessage>): ISubscription;
begin
  Result := GetEvent<TMessage>.Subscribe(AAction);
end;

end.

Комментарии?

Откройте этот URL-адрес и скачайте zip-файл http://qc.embarcadero.com/wc/qcmain.aspx?d=91796