Crèation d'un singleton

0/5 (13 avis)

Snippet vu 6 979 fois - Téléchargée 35 fois

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

Ajouter un commentaire Commentaires
MoveX Messages postés 230 Date d'inscription vendredi 9 mai 2003 Statut Membre Dernière intervention 16 juillet 2005 1
28 oct. 2004 à 15:38
singleton?? what is this?
JulioDelphi Messages postés 2226 Date d'inscription dimanche 5 octobre 2003 Statut Membre Dernière intervention 18 novembre 2010 14
28 oct. 2004 à 15:40
hello,
une petite définition d'un Singleton aurait été la bienvenue :

Le singleton est ce que l'on apelle un design pattern. Son but est d'éviter de multiplier les objets(et donc les ressources en mémoire) identiques. Autrement il offre la possibilité d'utiliser un même(on parle souvent d'unicité) objet tout au long d'un programme, ce qui permet donc d'améliorer votre application.
[source : google]

N'oubliez pas de cliquer sur Réponse acceptée lorsque la réponse vous convient ! [;)]

-------------------------------------------
[url]http://diabloporc.free.fr/url : mon site refait ! Delphi power !
cs_MHI Messages postés 110 Date d'inscription jeudi 7 octobre 2004 Statut Membre Dernière intervention 19 février 2009 1
28 oct. 2004 à 18:22
Effectivement j'aurai du expliquer ce qu'était un Singleton. Il s'agit bien d'un Design Patterns. Un singleton doit etre unique tous au long de son cycle de vie.

Pour plus d'info sur le Singleton : http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnpatterns/html/DesSingleton.asp
cs_MHI Messages postés 110 Date d'inscription jeudi 7 octobre 2004 Statut Membre Dernière intervention 19 février 2009 1
28 oct. 2004 à 18:30
La notion de Singleton n'est pas nouvelle, beaucoup l'utilise indirectement sans s'en rendre compte un l'intermédiaire un objet qu'il instancie au début de l'appli et se serve de cet objet par l'intermédiaire d'une variable globale.
cs_Delphiprog Messages postés 4297 Date d'inscription samedi 19 janvier 2002 Statut Membre Dernière intervention 9 janvier 2013 32
28 oct. 2004 à 19:36
Le modèle de code donné par MHI n'est pas tout à fait conforme au design pattern Singleton.
En effet, un appel à la méthode Create (héritée de TObject ici) contourne complètement l'effet recherché, à savoir une seule et unique instance de la classe en mémoire.
ModelMaker respecte le design pattern singleton et produit automatiquement le code ci-dessous :
unit USingleton;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs;

type
TSingleton = class (TObject)
protected
constructor CreateInstance;
class function AccessInstance(Request: Integer): TSingleton;
public
constructor Create;
destructor Destroy; override;
class function Instance: TSingleton;
class procedure ReleaseInstance;
end;


procedure Register;

implementation

procedure Register;
begin
end;

{
********************************** TSingleton **********************************
}
constructor TSingleton.Create;
begin
inherited Create;
raise Exception.CreateFmt('Access class %s through Instance only',
[ClassName]);
end;

constructor TSingleton.CreateInstance;
begin
inherited Create;
end;

destructor TSingleton.Destroy;
begin
if AccessInstance(0) = Self then AccessInstance(2);
inherited Destroy;
end;

class function TSingleton.AccessInstance(Request: Integer): TSingleton;

const FInstance: TSingleton = nil;

begin
case Request of
0 : ;
1 : if not Assigned(FInstance) then FInstance := CreateInstance;
2 : FInstance := nil;
else
raise Exception.CreateFmt('Illegal request %d in AccessInstance',
[Request]);
end;
Result := FInstance;
end;

class function TSingleton.Instance: TSingleton;
begin
Result := AccessInstance(1);
end;

class procedure TSingleton.ReleaseInstance;
begin
AccessInstance(0).Free;
end;


end.
---------------
Pour ceux qui ont la chance de disposer de ce logiciel (livré avec Delphi 7), je vous recommande de lire le document "Design pattern Reference's guide" au format pdf (mmdesignpatterns.pdf).
Pour les allergiques à la langue anglaise, vous trouverez également sur http://hcesbronlavau.developpez.com/DesignPatterns/ un très bon didacticiel.
S'inscrire maintenant

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.

Du même auteur (cs_MHI)