Event aggregator - cast object to interface?

I think, a possible workaround is to use a non-generic interface with GUID: IMessageHandler = interface '...' procedure Handle(const AMessage: TValue); end.

To be able to check if an instance implements a given interface, that interface needs to have a defined GUID. So, add a guid to your interface (you'll also need this guid in a const or variable so you may refernce it later in code): const IID_Handle: TGUID = '{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}'; type IHandle = interface '{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}' procedure Handle(AMessage: TMessage); end; (You shouldn't use my guid, it's just an example.. press ctrl+shift+G to generate a new guid in the IDE). Then check to see if the registered subscriber supports this interface: // LTarget:= LReference as IHandle; // Handle(AMessage); However, this doesn't take the generic part of the interface into account, it only checks the GUID.So you'll need some more logic around this to check if the target actually supports the message type.

Also, since you're dealing with classes that will be implementing an interface, and thus should derive from TInterfacedObject (or a compatible interface to that class) you should keep all references to the created object in interface variables, thus change the subscrber list from a reference to TObjects' to one of IInterfaces'. And there is a specific class for that, too: FSubscribers: TInterfaceList; Of course, you'll have to change the signature to the subscribe/unsubscribe functions too: procedure Subscribe(AInstance: IInterface); procedure Unsubscribe(AInstance: IInterface); I think a better way would be to take out the generic of the IHandle interface. That way you can enforce that all subscribers implement the basic IHandler interface by changing the subscribe/unsibscribe signature to take IHandler instead of IInterface.

IHandler can then hold the functionality required to determine if the subscriber supports the given message type or not. This will be left as an excercise to the reader. You might want to start with my little test app (D2010) which you can download from My Test App.

N.B. The test app explores the possibility of using generics in the interface, and will most likely crash when publishing events. Use the debugger to single step to see what happens. I doesn't crash when publishing integer 0, which seems to work.

The reason is that both Int and String handler will be called regardless of input type to Publish (as discussed earlier).

Another approach would be to skip interfaces altogheter and go with the dispatch functionality of TObject. We need a message record for this: TMessage = record MessageId: Word; Value: TValue; end; as well as some event ID's: const EVENT_BASE = WM_USER; MY_EVENT = EVENT_BASE; OTHER_EVENT = MY_EVENT + 1; and update the publish routine: procedure TEventAggregator. Publish(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; Then ANY object may be a subscriber to events. To handle a event, the handler only needs to specify which event id to handle (or catch it in the DefaultHandler). To handle the MY_EVENT message, simply add this to a class: procedure HandleMyEvent(var Msg: TMessage); message MY_EVENT; See also the example on dispatch from the delphi documentation: TObjectDispatch This way we can publish messages and let the subscriber pick and choose which ones to handle.

Also, the type can be determined in the handler. Also, one might declare (in documentation, not code) that a given event id should be of a given type, so the event handler for MY_EVENT could simply access the value as Msg.Value.AsInteger. N.B.The message is passed as var, so it may get modified by the subscribers.

If this is not acceptable, the Msg record must be reinitialized before each dispatch.

Working prototype. Not tested in production! Unit zEventAggregator; interface uses Classes, TypInfo, SysUtils, Generics.

Collections; type /// /// Denotes a class which can handle a particular type of message. /// /// The type of message to handle. IHandle = interface /// /// Handles the message.

/// /// The message. Procedure Handle(AMessage: TMessage); end; /// /// Subscription token /// ISubscription = interface '{3A557B05-286B-4B86-BDD4-9AC44E8389CF}' procedure Dispose; function GetSubscriptionType: string; property SubscriptionType: string read GetSubscriptionType; end; TSubscriber = class(TInterfacedObject, ISubscription) strict private FAction: TProc; FDisposed: Boolean; FHandle: IHandle; FOwner: TList > ; public constructor Create(AOwner: TList > ; AAction: TProc; AHandle: IHandle); destructor Destroy; override; procedure Dispose; procedure Publish(AMessage: T); function GetSubscriptionType: string; end; TEventBroker = class strict private FSubscribers: TList > ; public constructor Create; destructor Destroy; override; procedure Publish(AMessage: T); function Subscribe(AAction: IHandle): ISubscription; overload; function Subscribe(AAction: TProc): ISubscription; overload; end; TBaseEventAggregator = class strict protected FEventBrokers: TObjectDictionary; public constructor Create; destructor Destroy; override; function GetEvent: TEventBroker; end; /// /// Enables loosely-coupled publication of and subscription to events. /// TEventAggregator = class(TBaseEventAggregator) public /// /// Publishes a message.

/// /// The type of message being published. /// The message instance. Procedure Publish(AMessage: TMessage); /// /// Subscribes an instance class handler IHandle to all events of type TMessage/> /// function Subscribe(AAction: IHandle): ISubscription; overload; /// /// Subscribes a method to all events of type TMessage/> /// function Subscribe(AAction: TProc): ISubscription; overload; end; implementation { TSubscriber } constructor TSubscriber.

Create(AOwner: TList > ; AAction: TProc; AHandle: IHandle); begin FAction := AAction; FDisposed := False; FHandle := AHandle; FOwner := AOwner; end; destructor TSubscriber. Destroy; begin Dispose; inherited; end; procedure TSubscriber. 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.

GetSubscriptionType: string; begin Result:= GetTypeName(TypeInfo(T)); end; procedure TSubscriber. Publish(AMessage: T); var a: TProc; begin if Assigned(FAction) then TProc(FAction)(AMessage) else if Assigned(FHandle) then FHandle. Handle(AMessage); end; { TEventBroker } constructor TEventBroker.

Create; begin FSubscribers := TList > . Create; end; destructor TEventBroker. Destroy; begin FreeAndNil(FSubscribers); inherited; end; procedure TEventBroker.

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

Exit(Self); end; end; function TEventBroker. Subscribe(AAction: IHandle): ISubscription; var LSubscriber: TSubscriber; begin TMonitor. Enter(Self); try LSubscriber := TSubscriber.

Create(FSubscribers, nil, AAction); FSubscribers. Add(LSubscriber); Result := LSubscriber; finally TMonitor. Exit(Self); end; end; function TEventBroker.

Subscribe(AAction: TProc): ISubscription; var LSubscriber: TSubscriber; begin TMonitor. Enter(Self); try LSubscriber := TSubscriber. Create(FSubscribers, AAction, nil); FSubscribers.

Add(LSubscriber); Result := LSubscriber; finally TMonitor. Exit(Self); end; end; { TBaseEventAggregator } constructor TBaseEventAggregator. Create; begin FEventBrokers := TObjectDictionary.

Create(doOwnsValues); end; destructor TBaseEventAggregator. Destroy; begin FreeAndNil(FEventBrokers); inherited; end; function TBaseEventAggregator. GetEvent: TEventBroker; 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.

Create; FEventBrokers. Add(LEventType, LEventBroker); end; finally TMonitor. Exit(Self); end; end; Result := TEventBroker(LEventBroker); end; { TEventAggregator } procedure TEventAggregator.

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

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

Comments?

Open this url and grab the zip file qc.embarcadero.com/wc/qcmain.aspx?d=91796.

I cant really gove you an answer,but what I can give you is a way to a solution, that is you have to find the anglde that you relate to or peaks your interest. A good paper is one that people get drawn into because it reaches them ln some way.As for me WW11 to me, I think of the holocaust and the effect it had on the survivors, their families and those who stood by and did nothing until it was too late.

Related Questions