事件聚合 - 鑄造工件接口

Question

如何找出如果對象支持IHandle < T>和有任何可能的解決方法在德爾福（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; 

更新

我想通過馬爾科姆·格羅夫斯link

點出優秀的文章「通用接口德爾福」，它描述我想實現什麼。

Answer 1

工作原型。未在生產中測試！

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 2

我認爲，一個可能的解決方法是使用非通用接口GUID：

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

Answer 3

爲了能夠檢查是否有實例可實現給定的接口，該接口需要有一個定義的GUID。所以，一個GUID添加到您的界面（你還需要這一個常量或可變的GUID，所以你可以在後面的代碼refernce吧）：

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下載。

N.B.測試應用程序探討了在界面中使用泛型的可能性，並且在發佈事件時很可能會崩潰。使用調試器單步執行，看看會發生什麼。發佈整數0時，我不會崩潰，這似乎工作。 原因是無論輸入類型爲Publish（如前所述），都會調用Int和String處理程序。

Answer 4

另一種方法是跳過接口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中捕獲它）。在調度從德爾福文件

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

又見例如：

爲了處理MY_EVENT消息，只需將它添加到一個類TObjectDispatch

這樣我們就可以發佈消息，讓用戶挑選並選擇要處理的內容。此外，類型可以在處理程序中確定。此外，可以聲明（在文檔中，而不是代碼中）給定事件ID應該是給定類型，所以MY_EVENT的事件處理程序可以簡單地訪問值爲Msg.Value.AsInteger。

N.B.該消息以var的形式傳遞，因此它可能會被訂戶修改。如果這是不可接受的，則必須在每次調度之前重新初始化消息記錄。

Answer 5

打開這個網址，抓住zip文件 http://qc.embarcadero.com/wc/qcmain.aspx?d=91796