Crèation d'un singleton

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

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.