事件聚合器 - 将对象转换为接口

Question

如何确定对象是否支持 IHandleT> 以及在 delphi（2010，XE）中是否有任何可能的解决方法来实现这一点？还有没有人看到一个很好的 delphi 事件聚合器实现？

IHandle<TMessage> = interface
 procedure Handle(AMessage: TMessage);
end;

EventAggregator = class
private
 FSubscribers: TList<TObject>;
public
 constructor Create;
 destructor Destroy; override;
 procedure Subscribe(AInstance: TObject);
 procedure Unsubscribe(AInstance: TObject);
 procedure Publish<T>(AMessage: T);
end;

procedure EventAggregator.Publish<T>(AMessage: T);
var
  LReference: TObject;
  LTarget: IHandle<T>;
begin
    for LReference in FSubscribers do
    begin
      LTarget:= LReference as IHandle<T>; // <-- Wish this would work
      if Assigned(LTarget) then
        LTarget.Handle(AMessage);
    end;
end;

procedure EventAggregator.Subscribe(AInstance: TObject);
begin
 FSubscribers.Add(AInstance);
end;

procedure EventAggregator.Unsubscribe(AInstance: TObject);
begin
 FSubscribers.Remove(AInstance)
end;

更新

我想指出 Malcolm Groves link 的优秀文章“Delphi 中的通用接口”

它准确地描述了我想要实现的目标。

Answer 1

我认为，一种可能的解决方法是使用带有 GUID 的非通用接口：

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

Answer 2

为了能够检查实例是否实现了给定接口，该接口需要具有定义的 GUID。因此，在您的界面中添加一个 guid（您还需要在 const 或变量中使用此 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 在 IDE 中生成新的 guid）。

然后查看注册的订阅者是否支持这个接口：

//      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 而不是 IInterface 来强制所有订阅者实现基本 IHandler 接口。

然后，IHandler 可以保存确定订阅者是否支持给定消息类型所需的功能。

这将作为练习留给读者。您可能想从我的小测试应用程序 (D2010) 开始，您可以从 My Test App 下载它。

注意测试应用探索在界面中使用泛型的可能性，并且在发布事件时很可能会崩溃。使用调试器单步查看会发生什么。发布整数 0 时我不会崩溃，这似乎可行。 原因是无论要发布的输入类型如何，都会调用 Int 和 String 处理程序（如前所述）。

Answer 3

另一种方法是完全跳过接口并使用 TObject 的调度功能。

为此我们需要一条消息记录：

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

以及一些事件 ID：

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;

那么任何对象都可能是事件的订阅者。要处理一个事件，handler 只需要指定要处理的事件 id（或在 DefaultHandler 中捕获它）。

要处理 MY_EVENT 消息，只需将其添加到类中：

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

另请参阅 delphi 文档中的调度示例：TObjectDispatch

这样我们可以发布消息并让订阅者选择要处理的消息。此外，可以在处理程序中确定类型。此外，可以声明（在文档中，而不是代码中）给定的事件 id 应该是给定的类型，因此 MY_EVENT 的事件处理程序可以简单地以 Msg.Value.AsInteger 访问该值。

注意该消息作为var 传递，因此它可能会被订阅者修改。如果这不可接受，则必须在每次发送前重新初始化 Msg 记录。

Answer 4

工作原型。未在生产中测试！

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.

评论？

Answer 5

打开此网址并获取 zip 文件 http://qc.embarcadero.com/wc/qcmain.aspx?d=91796