unit uSingleton;

interface

uses Dialogs, Classes;

type


  TMySingleton = class(TObject)
  private
    class var _MySingletonInstance: TObject;
    class var _PreparadoParaLiberar: Boolean;

    FHello: TstringList;
    FDateTime: string;

  protected
    //se executar isso o objeto pode ser destruido
    class procedure PrepararParaLiberar; virtual;

    class function GetInstance: TMySingleton; static;

    //para criar ou destruir os componentes do objeto
    procedure InicializarObjeto; virtual;
    procedure FinalizarObjeto; virtual;
  public
    procedure SetHello(vHello: string);
    procedure SayHello; virtual;
    constructor Create;  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;
    destructor Destroy; override;
    class property Instance: TMySingleton  read GetInstance;
  end;

implementation

uses SysUtils;




{ TMySingleton }


procedure TMySingleton.SayHello;
begin
  //um metodo bobo pra testar
  ShowMessage('Classe: ' + Self.ClassName + #13#10 +
    'Mensagem: ' + FHello.Text + #13#10 +
    'Data: ' + FDateTime + #13#10 +
    'Instância: ' + inttostr(integer(self)));
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 inherited, 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.GetInstance: TMySingleton;
begin

  //isso é apenas um atalho em uma class function

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

  Result := _MySingletonInstance as TMySingleton;

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

  if (_MySingletonInstance = nil)  then
  begin
    //_MySingletonInstance := inherited NewInstance as TMySingleton;
    //_MySingletonInstance.FDateTime := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    _MySingletonInstance := inherited NewInstance;
    (_MySingletonInstance as TMySingleton).FDateTime := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
  end;

  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
  TMySingleton._MySingletonInstance := nil;
  TMySingleton._PreparadoParaLiberar := False;



finalization
  if (TMySingleton._MySingletonInstance <> nil) then
  try
    TMySingleton.PrepararParaLiberar;
    TMySingleton._MySingletonInstance.Free;
  except
    //tratamento de exceção, se precisar
  end;


end.


