Ver Mensaje Individual
  #1  
Antiguo 22-02-2017
Avatar de AgustinOrtu
[AgustinOrtu] AgustinOrtu is offline
Miembro Premium
 
Registrado: Aug 2013
Ubicación: Argentina
Posts: 1.838
Reputación: 9
AgustinOrtu Es un diamante en brutoAgustinOrtu Es un diamante en brutoAgustinOrtu Es un diamante en brutoAgustinOrtu Es un diamante en bruto
Forms con Reference Counting

En algunos casos puede ser util o necesario tener forms que implementen el conteo de referencias de modo tal que cuando la cantidad de referencias llega a 0, el form se destruye y se libera la memoria; si se desean usar interfaces e implementarlas usando algun descendiente de TForm

Al declarar una interfaz, implicitamente hereda de IInterface, por lo tanto si nuestro form implementa cualquier interfaz, necesariamente debe implementar IInterface; si bien es cierto que la clase TComponent (la cual es ancestro de TForm), implementa IInterface de manera tal que se deshabilita el reference counting, nosotros podemos "re-implementarla" para habilitarlo nuevamente.

Asi podemos utilizar interfaces en lugar de clases obteniendo bastante flexibilidad a la hora de programar; y tambien somos buenos samaritanos y no creamos aplicaciones con fugas de memoria

La implementacion es basicamente "copia y pega" de la clase TInterfacedObject. Necesitaremos una clase para el form con reference counting para el framework VCL y otra para el framework FMX

Primero vamos con la querida Vcl, en donde es algo mas facil ya que es terreno de los compiladores tradicionales para Windows y no tenemos que lidiar con multiplataforma:

Código Delphi [-]
interface

uses
  System.Classes,
  Vcl.Forms;

type
{$REGION 'TInterfacedForm'}
  ///  Form Vcl que implementa Reference Counting 
  TInterfacedForm = class(TForm, IInterface)
  strict private
    FRefCount: Integer;
    FHasOwner: Boolean;

    procedure CheckAssigned(Target: TObject);
  strict protected
{$REGION 'IInterface'}
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
{$ENDREGION}
    property HasOwner: Boolean read FHasOwner;
  public
    constructor Create; reintroduce;
    constructor CreateOwned(AOwner: TComponent);
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
  end;
{$ENDREGION}

implementation

uses
  System.SysUtils;

{$REGION 'TInterfacedForm'}

constructor TInterfacedForm.Create;
begin
  FHasOwner := False;
  inherited Create(nil);
end;

constructor TInterfacedForm.CreateOwned(AOwner: TComponent);
begin
  CheckAssigned(AOwner);
  FHasOwner := True;
  inherited Create(AOwner);
end;

procedure TInterfacedForm.CheckAssigned(Target: TObject);
begin
  if not Assigned(Target) then
    raise EArgumentNilException.Create('null argument');
end;

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

procedure TInterfacedForm.AfterConstruction;
begin
  System.AtomicDecrement(FRefCount);
  inherited AfterConstruction;
end;

procedure TInterfacedForm.BeforeDestruction;
begin
  if (FRefCount <> 0) and (not HasOwner) then
    System.Error(System.TRuntimeError.reInvalidPtr);
end;

{$REGION 'IInterface'}

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

function TInterfacedForm._AddRef: Integer;
begin
  if HasOwner then
    Result := -1
  else
    Result := System.AtomicIncrement(FRefCount);
end;

function TInterfacedForm._Release: Integer;
begin
  if HasOwner then
    Result := -1
  else
  begin
    Result := System.AtomicDecrement(FRefCount);
    if Result = 0 then
      Destroy;
  end;
end;

{$ENDREGION}

{$ENDREGION}

Aun asi, decidi dejar la posibilidad de utilizar la clase con el modelo de memoria de TComponent (es decir, basado en Owner).

Tenemos dos constructores: el constructor Create el cual se debe utilizar cuando queremos utilizar el form como una interface; y el constructor CreateOwned el cual es el que se debe utilizar cuando queremos que otro componente maneje el tiempo de vida

Al utilizar el constructor CreateOwned el reference counting se deshabilita; aun asi, se puede seguir utilizando variables de tipo interfaz para referenciar el form, y todo va a estar bien siempre y cuando se haya inicializado con un TComponent como Owner valido

Ahora, la implementacion para FMX, que es un pelin mas compleja:

Código Delphi [-]
interface

uses
  System.Classes,
  FMX.Forms;

type
{$REGION 'TInterfacedForm'}
  ///  Form FMX que implementa Reference Counting 
  TInterfacedForm = class(TForm, IInterface)
  strict private const
    objDestroyingFlag = Integer($80000000);
  strict private
    FHasOwner: Boolean;

    CheckAssigned(Target: TObject);

{$IFNDEF AUTOREFCOUNT}
    [Volatile] FRefCount: Integer;
    function GetRefCount: Integer; { inline; }
    class procedure __MarkDestroying(const Obj); static; { inline; }
    property RefCount: Integer read GetRefCount;
{$ENDIF AUTOREFCOUNT}
  strict protected
{$REGION 'IInterface'}
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
{$ENDREGION}
    property HasOwner: Boolean read FHasOwner;
  public
    constructor Create; reintroduce;
    constructor CreateOwned(AOwner: TComponent);
{$IFNDEF AUTOREFCOUNT}
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
{$ENDIF AUTOREFCOUNT}
  end;
{$ENDREGION}

implementation

uses
  System.SysUtils;

{$REGION 'TInterfacedForm'}

constructor TInterfacedForm.Create;
begin
  FHasOwner := False;
  inherited Create(nil);
end;

constructor TInterfacedForm.CreateOwned(AOwner: TComponent);
begin
  CheckAssigned(AOwner);
  FHasOwner := True;
  inherited Create(AOwner);
end;

procedure TInterfacedForm.CheckAssigned(Target: TObject);
begin
  if not Assigned(Target) then
    raise EArgumentNilException.Create('null argument');
end;

{$IFNDEF AUTOREFCOUNT}

class procedure TInterfacedForm.__MarkDestroying(const Obj);
var
  LRef: Integer;
begin
  repeat
    LRef := TInterfacedForm(Obj).FRefCount;
  until AtomicCmpExchange(TInterfacedForm(Obj).FRefCount, LRef or objDestroyingFlag, LRef) = LRef;
end;

function TInterfacedForm.GetRefCount: Integer;
begin
  Result := FRefCount and not objDestroyingFlag;
end;

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

procedure TInterfacedForm.AfterConstruction;
begin
  System.AtomicDecrement(FRefCount);
end;

procedure TInterfacedForm.BeforeDestruction;
begin
  if (RefCount <> 0) and (not HasOwner) then
    System.Error(System.TRuntimeError.reInvalidPtr);
end;

{$ENDIF AUTOREFCOUNT}

{$REGION 'IInterface'}

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

function TInterfacedForm._AddRef: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  if HasOwner then
    Result := -1
  else
    Result := System.AtomicIncrement(FRefCount);
{$ELSE}
  Result := __ObjAddRef;
{$ENDIF AUTOREFCOUNT}
end;

function TInterfacedForm._Release: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  if HasOwner then
    Result := -1
  else
  begin
    Result := System.AtomicDecrement(FRefCount);
    if Result = 0 then
    begin
      // Mark the refcount field so that any refcounting during destruction doesn't infinitely recurse.
      __MarkDestroying(Self);
      Destroy;
    end;
  end;
{$ELSE}
  Result := __ObjRelease;
{$ENDIF AUTOREFCOUNT}
end;

{$ENDREGION}

{$ENDREGION}

Si bien la implementacion parece muy de bajo nivel, como comentaba mas arriba, es una replica de lo que hace TInterfacedObject

Solo he podido probar las dos clases en Windows y Android y todo parece ir bien

Saludos

Última edición por AgustinOrtu fecha: 22-02-2017 a las 07:51:17.
Responder Con Cita