Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Trucos (https://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Forms con Reference Counting (https://www.clubdelphi.com/foros/showthread.php?t=91511)

AgustinOrtu 22-02-2017 07:47:58

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

Casimiro Notevi 22-02-2017 11:13:17

^\||/^\||/^\||/

newtron 22-02-2017 11:48:20

Cita:

Empezado por Casimiro Notevi (Mensaje 513585)
^\||/^\||/^\||/

Oye Antonio.... ¿este tío tan listo de dónde lo habéis sacado? ¿es un marciano o algo? :D:D

Casimiro Notevi 22-02-2017 12:40:37

Es un robot con inteligencia artificial que hemos puesto en marcha :D

miado 22-02-2017 13:52:31

Gracias compi,
Curioso el tema este.:eek:

AgustinOrtu 22-02-2017 16:01:21

Cita:

Empezado por newtron (Mensaje 513586)
Oye Antonio.... ¿este tío tan listo de dónde lo habéis sacado? ¿es un marciano o algo? :D:D

Cita:

Empezado por Casimiro Notevi (Mensaje 513587)
Es un robot con inteligencia artificial que hemos puesto en marcha :D

Venga, venga, no es para tanto :o

roman 22-02-2017 16:51:07

¡Caramba! Hoy está que echa lumbre! :eek: :)

LineComment Saludos


La franja horaria es GMT +2. Ahora son las 04:33:26.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi