aggrégateur événement - objet coulé à l'interface

Question

Comment savoir si l'objet prend en charge ihandle < T> et il toute solution possible pour y parvenir en delphi (2010, XE)? Est-ce que quelqu'un a vu une bonne implémentation de l'agrégateur d'événements pour 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; 

Mise à jour

Je voudrais souligner l'excellent article "Interfaces génériques dans Delphi" par Malcolm Groves link

qui décrit exactement ce que je voudrais réaliser.

Answer 1

Prototype de travail. Non testé en production!

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. 

Commentaires?

Answer 2

Je pense, une solution de contournement possible consiste à utiliser une interface non-générique avec GUID:

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

Answer 3

Pour être en mesure de vérifier si une instance implémente une interface donnée, cette interface doit avoir un GUID défini. Alors, ajoutez un guid à votre interface (vous aurez également besoin de ce guid dans un const ou variable de sorte que vous pouvez refernce ultérieurement dans le code):

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

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

(Vous ne devriez pas utiliser mon guid, il est juste un exemple .. appuyez sur ctrl + shift + G pour générer un nouveau guid dans l'IDE).

vérifier ensuite si l'abonné enregistré supporte cette interface:

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

Cependant, cela ne prend pas la partie générique de l'interface en compte, il vérifie que le GUID.

Vous aurez donc besoin de plus de logique pour vérifier si la cible prend réellement en charge le type de message. Etant donné que vous avez affaire à des classes qui implémenteront une interface, et devraient donc dériver de TInterfacedObject (ou une interface compatible avec cette classe), vous devriez garder toutes les références à l'objet créé dans les variables d'interface, donc changer la liste des sous-traitants à partir d'une référence à TObjects 'à l'une des IInterfaces'. Et il y a une classe spécifique pour cela aussi:

FSubscribers: TInterfaceList; 

Bien sûr, vous devrez changer la signature des fonctions/désabonnement vous abonner aussi:

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

Je pense une meilleure façon serait être de sortir le générique de l'interface IHandle. De cette façon, vous pouvez faire en sorte que tous les abonnés implémentent l'interface IHandler de base en changeant la signature subscribe/unsibscribe pour prendre IHandler au lieu de IInterface. IHandler peut alors conserver la fonctionnalité requise pour déterminer si l'abonné prend en charge le type de message donné ou non.

Cela sera laissé comme un exercice au lecteur. Vous pouvez commencer avec ma petite application de test (D2010) que vous pouvez télécharger à partir de My Test App.

N.B. L'application de test explore la possibilité d'utiliser des génériques dans l'interface et tombera probablement en panne lors de la publication d'événements. Utilisez le débogueur en une seule étape pour voir ce qui se passe.Je ne plante pas lors de la publication de l'entier 0, ce qui semble fonctionner. La raison en est que les gestionnaires Int et String seront appelés quel que soit le type d'entrée à publier (comme indiqué plus haut).

Answer 4

Une autre approche serait de sauter les interfaces altogheter et aller avec la fonctionnalité de répartition de TObject.

Nous avons besoin d'un enregistrement de message pour cette:

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

ainsi que d'un événement ID de:

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

et mettre à jour la publication de routine:

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; 

alors tout objet peut être un abonné aux événements. Pour gérer un événement, le gestionnaire n'a besoin que de spécifier l'identifiant de l'événement à gérer (ou l'attraper dans DefaultHandler).

Pour gérer le message MY_EVENT, simplement ajouter à une classe:

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

Voir aussi l'exemple à l'expédition de la documentation delphi: TObjectDispatch

De cette façon, nous pouvons publier des messages et laisser l'abonné Choisissez et choisissez ceux à gérer. En outre, le type peut être déterminé dans le gestionnaire. En outre, on peut déclarer (dans la documentation, pas le code) qu'un ID d'événement donné doit être d'un type donné, de sorte que le gestionnaire d'événements pour MY_EVENT peut simplement accéder à la valeur Msg.Value.AsInteger.

N.B. Le message est passé comme var, donc il peut être modifié par les abonnés. Si cela n'est pas acceptable, l'enregistrement Msg doit être réinitialisé avant chaque envoi.

Answer 5

Ouvrir cette URL et récupérer le fichier zip http://qc.embarcadero.com/wc/qcmain.aspx?d=91796