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

Question

如何找出对象是否支持IHandle＆lt; T＆gt; 并且是否有任何可能的解决方法在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撰写的优秀文章“Delphi中的通用接口”link

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

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（或该类的兼容接口）派生，您应该在接口变量中保留对创建对象的所有引用，从而更改从对象的引用到IInterfaces之一的subscrber列表。并且还有一个特定的类：

FSubscribers: TInterfaceList;

当然，您还必须将签名更改为subscribe / unsubscribe功能：

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

我认为更好的方法是取出IHandle接口的通用。这样，您可以通过更改subscribe / unsibscribe签名来强制所有订阅者实现基本的IHandler接口，从而使用IHandler而不是IInterface。

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

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

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

Answer 3

另一种方法是跳过接口altogheter并使用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;

然后任何对象可能是事件的订阅者。要处理事件，处理程序只需要指定要处理的事件id（或在DefaultHandler中捕获它）。

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

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

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

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

N.B。消息以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