Tecsitel_FactuGES2/Source/Base/Controladores/uControllerBase.pas

unit uControllerBase;

interface

uses
  Classes, uDADataTable, Forms;

type
  ISujeto = interface;

  IObservador = interface(IInterface)
  ['{679D5CF2-D5DC-4A52-9FF3-04AD91402483}']
    procedure RecibirAviso(ASujeto: ISujeto); overload;
    procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); overload;
  end;

  ISujeto = interface(IInterface)
  ['{CDB691CD-D1D6-4F2E-AA34-93B1CD0E6030}']
    procedure AddObservador(Observador: IObservador);
    procedure DeleteObservador(Observador: IObservador);
  end;

  { ******************* PARA PRUEBAS ******************************************}
  IMiInterface = interface(IInterface)
    ['{C4C3F81D-4318-457C-860A-6034617FE39E}']
    function GetRefCount : Integer;
  end;

  TMiInterfacedObject = class(TObject, IInterface)
  protected
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function GetRefCount : Integer;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;

  TMiInterfacedObject2 = class(TDataModule) //, IInterface)
  end;

  { ***************************************************************************}


  TObservador = class(TInterfacedObject, IObservador)
  protected
    procedure RecibirAviso(ASujeto: ISujeto); overload; virtual;
    procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); overload; virtual; abstract;
  end;

  TSujeto = class(TInterfacedObject, ISujeto)
  private
    fObservadores: IInterfaceList;
  protected
    procedure AvisarObservadores; overload;
    procedure AvisarObservadores(ADataTable: IDAStronglyTypedDataTable); overload;
  public
    constructor Create; virtual;
    procedure AddObservador(Observador: IObservador);
    procedure DeleteObservador(Observador: IObservador);
    destructor Destroy; override;
  end;

  IControllerBase = IObservador;
  TControllerBase = TObservador;

implementation

uses
  Dialogs, SysUtils;


function InterlockedIncrement(var I: Integer): Integer;
asm
      MOV   EDX,1
      XCHG  EAX,EDX
 LOCK XADD  [EDX],EAX
      INC   EAX
end;

function InterlockedDecrement(var I: Integer): Integer;
asm
      MOV   EDX,-1
      XCHG  EAX,EDX
 LOCK XADD  [EDX],EAX
      DEC   EAX
end;

{ TMiInterfacedObject }

procedure TMiInterfacedObject.AfterConstruction;
begin
// Release the constructor's implicit refcount
  InterlockedDecrement(FRefCount);
end;

procedure TMiInterfacedObject.BeforeDestruction;
begin
  if RefCount <> 0 then
    Error(reInvalidPtr);
end;

function TMiInterfacedObject.GetRefCount: Integer;
begin
  Result := FRefCount;
end;

// Set an implicit refcount so that refcounting
// during construction won't destroy the object.
class function TMiInterfacedObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TMiInterfacedObject(Result).FRefCount := 1;
end;

function TMiInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TMiInterfacedObject._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
//  ShowMessage('_AddRef: ' + ClassName + ' - RefCount: ' + IntToStr(FRefCount));
end;

function TMiInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
//  ShowMessage('_Release: ' + ClassName + ' - RefCount: ' + IntToStr(FRefCount));
  if Result = 0 then
    Destroy;
end;



{ TSujeto }

procedure TSujeto.addObservador(Observador: IObservador);
begin
  FObservadores.Add(Observador);
end;

procedure TSujeto.AvisarObservadores;
var
  i: Integer;
  AObs : IObservador;
begin
  for i := 0 to Pred(FObservadores.Count) do
  begin
     if Supports(FObservadores[i], IObservador, AObs) then
        AObs.RecibirAviso(Self);
  end;
end;

procedure TSujeto.AvisarObservadores(ADataTable: IDAStronglyTypedDataTable);
var
  i: Integer;
  AObs : IObservador;
begin
  for i := 0 to Pred(FObservadores.Count) do
  begin
     if Supports(FObservadores[i], IObservador, AObs) then
        AObs.RecibirAviso(Self, ADataTable);
  end;
end;

constructor TSujeto.Create;
begin
  inherited;
  FObservadores := TInterfaceList.Create;
end;

procedure TSujeto.DeleteObservador(Observador: IObservador);
begin
  FObservadores.Remove(Observador);
end;

destructor TSujeto.Destroy;
begin
  FObservadores := NIL;
  inherited;
end;

{ TObservador }

procedure TObservador.RecibirAviso(ASujeto: ISujeto);
begin
  //
end;




end.