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 AddSujeto(Sujeto: ISujeto);
    procedure DeleteSujeto(Sujeto: ISujeto);
    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 ******************************************}
  TMiInterfacedObject = class(TObject, IInterface)
  protected
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; virtual; stdcall;
    function GetRefCount : Integer;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;


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


  TObservador = class(TObject, IObservador)
  private
    fSujetos: IInterfaceList;
  protected
    FRefCount: Integer;
    procedure RecibirAviso(ASujeto: ISujeto); overload; virtual;
    procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); overload; virtual; abstract;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function GetRefCount : Integer;
  public
    constructor Create; virtual;
    procedure AddSujeto(Sujeto: ISujeto);
    procedure DeleteSujeto(Sujeto: ISujeto);
    destructor Destroy; override;

    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  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);
  Observador.AddSujeto(Self);
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;

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

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

procedure TObservador.AddSujeto(Sujeto: ISujeto);
begin
  FSujetos.Add(Sujeto);
end;

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

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

constructor TObservador.Create;
begin
  inherited;
  FSujetos := TInterfaceList.Create;
end;

procedure TObservador.DeleteSujeto(Sujeto: ISujeto);
begin
  FSujetos.Remove(Sujeto);
end;

destructor TObservador.Destroy;
begin
  FSujetos := NIL;
  inherited;
end;

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

class function TObservador.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TObservador(Result).FRefCount := 1;
end;

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

end.