2 respuestas en este tema

[Agustin Ortu]

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:

delphi

interface
 
uses
  System.Classes,
  Vcl.Forms;
 
type
{$REGION 'TInterfacedForm'}
  /// <summar> Form Vcl que implementa Reference Counting </summary>
  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:
 

delphi

interface
 
uses
  System.Classes,
  FMX.Forms;
 
type
{$REGION 'TInterfacedForm'}
  /// <summar> Form FMX que implementa Reference Counting </summary>
  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

Editado por Agustin Ortu, 21 febrero 2017 - 11:56 .

[egostar]

Excelente aporte y muy interesante asunto este de las interfaces.

 

Saludos

[ELKurgan]

Gracias por el aporte

 

Saludos