POO: Objetos quot;Auto-instanciáveisquot;

TMeuFormSDI.Execute;

{ TDBUpdate }

procedure TDBUpdate.CheckCreate;
begin
  if not Assigned(DBUpdate) then
    DBUpdate := TDBUpdate.Create(nil);
end;

procedure TDBUpdate.TableCreate(Table: ShortString; Fields: array of ShortString);
begin
  CheckCreate;
  ...
end;

implementation

var
  fInstanciaMeuObjeto: TMeuObjeto = nil;
  fPermiteInstanciar: Boolean = False;

{...}

class function TMeuObjeto.Instance: TMeuObjeto;
begin
  if fInstanciaMeuObjeto=nil then
  begin
    fPermiteInstanciar := True;
    try
      fInstanciaMeuObjeto := TMeuObjeto.Create;
    finally
      fPermiteInstanciar := False;
    end;
  end;
  Result := fInstanciaMeuObjeto;
end;

constructor TMeuObjeto.Create; 
begin 
  inherited Create; 
  fLista := TStringList.Create; 
  fNome := ´´; 
  if not fPermiteInstanciar then
    raise Exception.Create(´não é possível criar este objeto´);
end; 

MeuObjeto.Free;
MeuObjeto.Free;
MeuObjeto.Free;
MeuObjeto.Nome := ´Teste 1´;
MeuObjeto.Free;
MeuObjeto.Free;
MeuObjeto.Nome := ´Teste 2´;

{
  essa unit tem uma classe que implementa o padrão singleton, ou seja, apenas
  uma instancia desta pode existir.

  você não pode dar free nesse objeto, mas ele é liberado da memoria
  automaticamente atraves da seção finalization da unit, executando o
  metodo privado estatico (a unica utilidade que eu já vi para metodo privado
  estatico)      class procedure PrepararParaLiberar; Depois disso o objeto pode
  ser destruido normalmente

  Essa classe não pode ter descendentes. Se tiver, a variavel global que
  guarda a instancia do singleton conterá apenas uma instancia, ou da
  classe base ou da classe especializada.


  Ao ser liberada da memoria o metodo destroy
  da classe herdada não conseguirá liberar objetos
  criados e usados somente por esta classe
}

unit uSingleton;

interface

uses Dialogs, Classes;

type

  TMySingleton = class(TObject)
  private
    FHello: TstringList;
    //se executar isso o objeto pode ser destruido
    class procedure PrepararParaLiberar;
    //para criar ou destruir os componentes do objeto
    procedure InicializarObjeto;
    procedure FinalizarObjeto;
  public
    procedure SetHello(vHello: string);
    procedure SayHello; virtual;

    //esses caras misticos abaixo que realmente criam, alocam memoria, destroem e desalocam memoria por tráz dos constructor e destructor que conhecemos
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;

    constructor Create;
    destructor Destroy; override;

    class function InstanciaPadrao: TMySingleton;

  end;

implementation

var
  _MySingletonInstance: TMySingleton = nil;
  _PreparadoParaLiberar: Boolean = False;

{ TMySingleton }


procedure TMySingleton.SayHello;
begin
  //um metodo bobo pra testar
  ShowMessage(FHello.Text);
end;

procedure TMySingleton.SetHello(vHello: string);
begin
  //um outro metodo bobo pra setar a mensagem
  FHello.Text := vHello;
end;




constructor TMySingleton.Create;
begin
  //antes de tudo, antes mesmo do inherites, newinstance já é chamado por padrão
  inherited; //faz o que for preciso de seu ancestral, eu tenho certeza aqui que o NewInstance está sendo executado
  InicializarObjeto; //inicializo o que precisa
end;

destructor TMySingleton.Destroy;
begin
  FinalizarObjeto;  //destruo as partes ou objetos criados pela minha classe, como stringlists
  inherited;    //a destruição normal do objeto, depois disso freeinstance é chamado normalmente
end;



class function TMySingleton.InstanciaPadrao: TMySingleton;
begin
  //isso é apenas um atalho em uma class function
  Result := _MySingletonInstance;
end;





procedure TMySingleton.FreeInstance;
begin

  //no destructor não vai acontecer nada se _PreparadoParaLiberar for false, e eu não preciso disparar uma excessão

  //  agora se _PreparadoParaLiberar for true
  //eu faço o que um FreeInstance sempre deveria fazer, uso o inherited,
  if _PreparadoParaLiberar then
  begin
    inherited;
    //bloqueio a liberação  novamente
    _PreparadoParaLiberar := False;
    //atribuo nil
    _MySingletonInstance := nil;
  end;

  //agora se precisar pode criar de novo

end;

class function TMySingleton.NewInstance: TObject;
begin

  //se não está criada cria usando o inherited NewInstance da classe ancestral, TObject e atribui fazendo typecasting
  if _MySingletonInstance = nil then
  begin
    _MySingletonInstance := (inherited NewInstance as TMySingleton);
  end;

  //e retorna a mesma
  result := _MySingletonInstance;
end;

class procedure TMySingleton.PrepararParaLiberar;
begin
  //esse método só faz isso
  _PreparadoParaLiberar := True;
end;

procedure TMySingleton.FinalizarObjeto;
begin
  //aqui você poe somente as coisas que devem acontecer da destruição verdadeira do objeto
  if _PreparadoParaLiberar then
  begin
    FHello.Free;
  end;
end;

procedure TMySingleton.InicializarObjeto;
begin
  //aqui você poe tudo o que precisa que aconteça depois do create
  //lembrando que se o NewInstance já retornar o objeto criado, então
  //Self.FHello vai ser o Fhello dessa instancia, e vai ser <> de nil
  if (FHello = nil) then
  begin
    FHello := TStringList.Create;
  end;
end;



initialization
  //inicializo minhas variáveis publicas, porque vou mecher nelas posteriormente
  _MySingletonInstance := nil;
  _PreparadoParaLiberar := False;



finalization
  if Assigned(_MySingletonInstance) or (_MySingletonInstance <> nil) then
  try
    try
      TMySingleton.PrepararParaLiberar;
      _MySingletonInstance.Free;
    except
      //tratamento de excesão, se precisar
    end;
  finally
    _MySingletonInstance := nil;
  end;

end.

{
  faça o teste derradeiro: coloque um button na form e:

procedure TForm1.Button9Click(Sender: TObject);
var fmst: TMySingleton;
begin

  fmst := TMySingleton.Create;
  fmst.SetHello(´teste1´);
  fmst.SayHello;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;
  fmst := TMySingleton.Create;

  fmst.SetHello(´teste2´);
  fmst.SayHello;

  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Free;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;
  fmst.Destroy;

  fmst.SetHello(´teste3´);
  fmst.SayHello;

end;


}

type
  TMySingleton = class(TObject)
  private
   bla bla ...
  public
    bla ... bla;;
  // class function InstanciaPadrao: TMySingleton;  ********* Aqui 
  end;

function InstanciaPadrao: TMySingleton;

class function TMySingleton.NewInstance: TObject;
begin
 //se não está criada cria usando o inherited NewInstance da classe ancestral, TObject e atribui fazendo typecasting
  if _MySingletonInstance = nil then
  begin
    _MySingletonInstance := (inherited NewInstance as TMySingleton).Create;
  end;

  //e retorna a mesma
  result := _MySingletonInstance;
end;

class function TMySingleton.InstanciaPadrao: TMySingleton; 
begin 
  //isso é apenas um atalho em uma class function 
  Result := TMySingleton.Create; 
end; 

class function TMySingleton.InstanciaPadrao: TMySingleton; 
begin 
  //isso é apenas um atalho em uma class function 

  if _MySingletonInstance = nil then
    _MySingletonInstance := TMySingleton.Create;

  Result := _MySingletonInstance ;

end; 

function InstanciaPadrao: TMySingleton;
begin
 if _MySingletonInstance = nil then
    _MySingletonInstance := TMySingleton.Create;

  Result := _MySingletonInstance
end;

TMySingleton.InstanciaPadrao.SetHello(´oi´);  //usando metodo de classe
  InstanciaPadrao.SetHello(´oi´);  //Declarando um Função 

if Assigned(_MySingletonInstance) or (_MySingletonInstance <> nil) then 

try
  ...
finally 
  _MySingletonInstance := nil; 
end; 

unit uSingleton;

interface

uses
  SyncObjs, Dialogs;

type
{*-----------------------------------------------------------------------------
  Interface que define os métodos do Singleton
-------------------------------------------------------------------------------}
  ISingleton = interface
  [´{93E92DC7-BF57-4BD5-9ACF-B69E75EC37D0}´]
    procedure FacaAlgo;
  end;

{*-----------------------------------------------------------------------------
  Retorna a instância de um objeto que implementa a interface ISingleton.
-------------------------------------------------------------------------------}
  function Singleton: ISingleton;

implementation

var
  _Singleton: ISingleton = nil;

type
{*-----------------------------------------------------------------------------
  Classe interna que implementa a interface ISingleton.
-------------------------------------------------------------------------------}
  TSingleton = class(TInterfacedObject, ISingleton)
  private
  public
    procedure FacaAlgo;
  end;

  function Singleton: ISingleton;
  begin
    if not Assigned(_Singleton) then
    //Aqui poderia ter um Critical Section para ficar thread-safe
      _Singleton := TSingleton.Create as ISingleton;
      
    Result := _Singleton; 
  end;
  
{ TSingleton }

procedure TSingleton.FacaAlgo;
begin
  ShowMessage(´Estou fazendo algo...´); 
end;

end.

  function Singleton: ISingleton; 
  begin 
    if not Assigned(_Singleton) then 
    //Aqui poderia ter um Critical Section para ficar thread-safe 
      _Singleton := TSingleton.Create as ISingleton; 
      
    Result := _Singleton; 
  end;