segunda-feira, 19 de novembro de 2018

Nullable types

Estou disponibilizando uma forma de implementar tipos "nuláveis" utilizando operators overload. Também disponibilizo extensões para os tipos "nuláveis" através record helpers.

Projeto com exemplos disponível no link:
https://drive.google.com/open?id=1KlvVPkxil80xvTLhCV4t9VUtkUbHvdJ7
Postado por às Nenhum comentário:
Marcadores: , , ,

terça-feira, 7 de agosto de 2018

Emissor de eventos / Fila de eventos

Para iniciar o blog, vou disponibilizar um emissor de eventos, criado com Delphi 2006.

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.














Postado por às Nenhum comentário:
Marcadores: , , , ,
Assinar: Comentários (Atom)