Baseado no emissor de eventos do Node JS, este emissor de eventos é uma forma de implementar o padrão de projeto "Observer".
Estou aplicando a teoria onde damos preferência à composição e não à herança. Então, este comportamento pode ser "acoplado" em outros implementos, possibilitando a extensão de comportamento.
Este implemento deve ser considerado um exemplo, sendo compatível também com as versões mais recentes do Delphi.
Para novas versões do Delphi, considere utilizar lista indexada, métodos anônimos e outros.
Ao que importa...
Primeiro declaro a classe responsável pelo gerenciamento dos eventos e também as interfaces de acesso:
TEventEmitter: classe responsável por registrar os destinatários e servir como emissor de eventos;
IEventListener: interface de acesso para registro de destinatários;
IEventEmitter: interface de acesso para emitir eventos.
O registro de destinatários requer o nome do evento monitorado e um método para notificação:
TEventName: nome do evento monitorado;
TEventProc: método para notificação.
* As interfaces podem ser utilizadas quando se quer gerar um proxy para restringir o acesso do código "cliente".
Vamos ao código fornecedor:
unit EventEmitter;
interface
uses
Contnrs, StrUtils, Classes;
type
TEventName = type string;
TEventProc = procedure(const Args: variant) of object;
TEventNames = array of TEventName;
TEventProcs = array of TEventProc;
IEventListener = interface
['{B1779812-8B14-47F3-82A4-485DBA4BEC39}']
procedure &On(const AEvtName: TEventName; const AEvtProc: TEventProc);
procedure Off(const AEvtName: TEventName; const AEvtProc: TEventProc);
procedure Once(const AEvtName: TEventName; const AEvtProc: TEventProc);
end;
IEventEmitter = interface
['{2B0ABCB1-E72D-4D9B-B91A-E076B110968A}']
procedure Emit(const AEvtName: TEventName; const Args: variant);
end;
TEventEmitter = class(TInterfacedPersistent, IEventEmitter, IEventListener)
private type
TEventRegistry = class
private
FEvtName: TEventName;
FEvtProc: TEventProc;
FMaxTriggeringCount: integer;
FTriggeringCount: integer;
public
constructor Create(const AEvtName: TEventName; const AEvtProc: TEventProc; const AMaxTriggeringCount: integer = 0);
property EvtName: TEventName read FEvtName;
property EvtProc: TEventProc read FEvtProc;
property MaxTriggeringCount: integer read FMaxTriggeringCount;
property TriggeringCount: integer read FTriggeringCount write FTriggeringCount;
end;
private
FEvents: TObjectList;
function IsSameEvt(const ALeftEvt, ARighEvt: TEventProc): boolean;
procedure DoTriggerEvent(const AEvtReg: TEventRegistry; const Args: variant);
function IsMaxTriggeringCount(const AEvtProc: TEventRegistry): boolean;
public
constructor Create();
destructor Destroy(); override;
procedure Emit(const AEvtName: TEventName; const Args: variant);
procedure AddListener(const AEvtName: TEventName; const AEvtProc: TEventProc; const AMaxTriggering: integer = 0);
procedure RemoveListener(const AEvtName: TEventName; const AEvtProc: TEventProc);
function EventNames: TEventNames;
function EventProcs(const AEvtName: string): TEventProcs;
procedure &On(const AEvtName: TEventName; const AEvtProc: TEventProc);
procedure Off(const AEvtName: TEventName; const AEvtProc: TEventProc);
procedure Once(const AEvtName: TEventName; const AEvtProc: TEventProc);
end;
const
EVT_NEW_LISTENER = 'newListener';
EVT_REMOVE_LISTENER = 'removeListener';
implementation
uses
Variants;
{ TAppEvt }
constructor TEventEmitter.Create;
begin
inherited Create;
FEvents := TObjectList.Create(true);
end;
destructor TEventEmitter.Destroy;
begin
FEvents.Free;
inherited;
end;
procedure TEventEmitter.Emit(const AEvtName: TEventName; const Args: variant);
var
I: Integer;
LEvtReg: TEventEmitter.TEventRegistry;
LRemovable: TObjectList;
begin
LRemovable := TObjectList.Create(false);
try
for I := 0 to FEvents.Count - 1 do begin
LEvtReg := TEventEmitter.TEventRegistry(FEvents.Items[I]);
if (LEvtReg.EvtName = AEvtName) then begin
try
DoTriggerEvent(LEvtReg, Args);
finally
if IsMaxTriggeringCount(LEvtReg) then begin
LRemovable.Add(LEvtReg)
end;
end;
end;
end;
finally
for I := 0 to LRemovable.Count - 1 do begin
FEvents.Remove(LRemovable.Items[I]);
end;
LRemovable.Free;
end;
end;
function TEventEmitter.EventNames: TEventNames;
var
I: Integer;
LEvtReg: TEventRegistry;
LEvtName: TEventName;
LFound: Boolean;
begin
SetLength(Result, 0);
for I := 0 to FEvents.Count - 1 do begin
LEvtReg := FEvents[I] as TEventRegistry;
LFound := false;
for LEvtName in Result do begin
if LEvtName = LEvtReg.EvtName then begin
LFound := true;
Break;
end;
end;
if not LFound then begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result)] := LEvtReg.EvtName;
end;
end;
end;
function TEventEmitter.EventProcs(const AEvtName: string): TEventProcs;
var
I: Integer;
LEvtReg: TEventRegistry;
LEvtProc: TEventProc;
LFound: boolean;
begin
SetLength(Result, 0);
for I := 0 to FEvents.Count - 1 do begin
LEvtReg := FEvents[I] as TEventRegistry;
LFound := false;
for LEvtProc in Result do begin
if IsSameEvt(LEvtProc, LEvtReg.EvtProc) then begin
LFound := true;
Break;
end;
end;
if not LFound then begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result)] := LEvtReg.EvtProc;
end;
end;
end;
function TEventEmitter.IsSameEvt(const ALeftEvt, ARighEvt: TEventProc): boolean;
begin
Result := (TMethod(ALeftEvt).Code = TMethod(ARighEvt).Code)
and (TMethod(ALeftEvt).Data = TMethod(ARighEvt).Data)
end;
procedure TEventEmitter.Off(const AEvtName: TEventName; const AEvtProc: TEventProc);
begin
RemoveListener(AEvtName, AEvtProc);
end;
procedure TEventEmitter.On(const AEvtName: TEventName; const AEvtProc: TEventProc);
begin
AddListener(AEvtName, AEvtProc);
end;
procedure TEventEmitter.Once(const AEvtName: TEventName;
const AEvtProc: TEventProc);
begin
AddListener(AEvtName, AEvtProc, 1);
end;
procedure TEventEmitter.DoTriggerEvent(const AEvtReg: TEventRegistry; const Args: variant);
begin
AEvtReg.TriggeringCount := AEvtReg.TriggeringCount + 1;
AEvtReg.EvtProc(Args);
end;
procedure TEventEmitter.AddListener(const AEvtName: TEventName;
const AEvtProc: TEventProc; const AMaxTriggering: integer = 0);
var
LFound: boolean;
I: integer;
LEvtReg: TEventRegistry;
begin
LFound := false;
for I := 0 to Pred(FEvents.Count) do begin
LEvtReg := FEvents[I] as TEventRegistry;
if (LEvtReg.EvtName = AEvtName) and IsSameEvt(LEvtReg.EvtProc, AEvtProc) then begin
LFound := true;
Break;
end;
end;
if not LFound then begin
FEvents.Add(
TEventEmitter.TEventRegistry.Create(AEvtName, AEvtProc, AMaxTriggering)
);
Emit(EVT_NEW_LISTENER, VarArrayOf([AEvtName, NativeInt(@@AEvtProc)]));
end;
end;
procedure TEventEmitter.RemoveListener(const AEvtName: TEventName;
const AEvtProc: TEventProc);
var
I: Integer;
LEvtReg: TEventRegistry;
begin
for I := 0 to Pred(FEvents.Count) do begin
LEvtReg := FEvents[I] as TEventRegistry;
if (LEvtReg.EvtName = AEvtName) and IsSameEvt(LEvtReg.EvtProc, AEvtProc) then begin
FEvents.Remove(LEvtReg);
Emit(EVT_REMOVE_LISTENER, VarArrayOf([AEvtName, NativeInt(@@AEvtProc)]));
Break;
end;
end;
end;
function TEventEmitter.IsMaxTriggeringCount(
const AEvtProc: TEventRegistry): boolean;
begin
Result := (AEvtProc.MaxTriggeringCount <> 0)
and (AEvtProc.TriggeringCount = AEvtProc.MaxTriggeringCount)
end;
{ TAppEvt.TEventRegistry }
constructor TEventEmitter.TEventRegistry.Create(const AEvtName: TEventName;
const AEvtProc: TEventProc; const AMaxTriggeringCount: integer = 0);
begin
inherited Create;
FEvtName := AEvtName;
FEvtProc := AEvtProc;
FMaxTriggeringCount := AMaxTriggeringCount;
FTriggeringCount := 0;
end;
end.
Código cliente:
unit Forms.EventEmitter;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, EventEmitter;
type
TFireApp = class
private
FEvtEmitter: TEventEmitter;
function GetEvtListener: IEventListener;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
procedure FireUp;
//Proxy para permitir apenas o registro de destinatários,
//impedindo que eventos sejam emitidos fora desta implementação
property EventListener: IEventListener read GetEvtListener;
end;
TEvtEmitterForm = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FFireApp: TFireApp;
procedure OnEvtAddListener(const Args: variant);
procedure OnEvtRemoveListener(const Args: variant);
procedure OnEvtFireOnce(const Args: variant);
procedure OnEvtFire(const Args: variant);
end;
var
EvtEmitterForm: TEvtEmitterForm;
implementation
{$R *.dfm}
{ TForm4 }
procedure TEvtEmitterForm.FormCreate(Sender: TObject);
begin
FFireApp := TFireApp.Create;
FFireApp.EventListener.On(EVT_NEW_LISTENER, OnEvtAddListener);
FFireApp.EventListener.On(EVT_REMOVE_LISTENER, OnEvtRemoveListener);
FFireApp.EventListener.Once('onFire', OnEvtFireOnce);
FFireApp.EventListener.On('onFire', OnEvtFire);
FFireApp.FireUp; //na primeiva vez, o evento OnEvtFireOnce e OnEvtFire é executado
FFireApp.FireUp; //na segunda vez, o evento OnEvtFire é executado e o evento OnEvtFireOnce não é executado
//EVT_NEW_LISTENER e EVT_REMOVE_LISTENER serão executados sempre que registrar ou remover um destinatário
end;
procedure TEvtEmitterForm.FormDestroy(Sender: TObject);
begin
FFireApp.Free;
end;
procedure TEvtEmitterForm.OnEvtAddListener(const Args: variant);
begin
//
end;
procedure TEvtEmitterForm.OnEvtFire(const Args: variant);
begin
//
end;
procedure TEvtEmitterForm.OnEvtFireOnce(const Args: variant);
begin
//
end;
procedure TEvtEmitterForm.OnEvtRemoveListener(const Args: variant);
begin
//
end;
{ TFireApp }
procedure TFireApp.AfterConstruction;
begin
inherited;
FEvtEmitter := TEventEmitter.Create;
end;
procedure TFireApp.BeforeDestruction;
begin
inherited;
FEvtEmitter.Free;
end;
function TFireApp.GetEvtListener: IEventListener;
begin
Result := FEvtEmitter;
end;
procedure TFireApp.FireUp;
begin
FEvtEmitter.Emit('onFire', null);
end;
end.
*Obs: o arquivo .dfm é trivial ao implemento do formulário.
