Crèation d'un singleton

Commenter

Contenu du snippet

Crèation d'un objet Singleton

utilisation

s1 := TSingleton.Create;
s2 := TSingleton.Create;
ShowMessage(s1.Text);
s2.Text := 'Pour finir !!';
ShowMessage(s1.Text);
s2.Free;
s1.Free;

Source / Exemple : 


interface

type
  TSingleton = class
  private
    FText: string;
  public
    procedure FreeInstance; override;
    class function NewInstance: TObject; override;
    class function RefCount: Integer;
    property Text: string read FText write FText; // pour tester
  end;

implementation

var
  TheInstanceOfSingleton: TObject = nil;
  SingletonRefCount: Integer = 0;

procedure TSingleton.FreeInstance;
begin
  Dec(SingletonRefCount);
  if (SingletonRefCount = 0) then
  begin
    TheInstanceOfSingleton := nil;
    inherited FreeInstance;
  end;
end;

class function TSingleton.NewInstance: TObject;
begin
  if not Assigned(TheInstanceOfSingleton) then
  begin
    TheInstanceOfSingleton := inherited NewInstance;
    TSingleton(TheInstanceOfSingleton).Text := 'Dans un premier temps';
  end;
  Result := TheInstanceOfSingleton;
  Inc(SingletonRefCount);
end;

class function TSingleton.RefCount: Integer;
begin
  Result := SingletonRefCount;
end;

A voir également

Du même auteur (cs_MHI)