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'}
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'}
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;
class procedure __MarkDestroying(const Obj); static;
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
__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