Vos recrutements informatiques

700 000 développeurs, chefs de projets, ingénieurs, informaticiens...

Contactez notre équipe spécialiste en recrutement

Tutoriel

Comment implémenter un Singleton avec Delphi 7

Le patron de conception « Singleton » est un modèle visant à limiter l'instanciation d'une classe à un seul et unique objet. Il est couramment utilisé pour coordonner des opérations dans un système.

24 commentaires Donner une note à l'article (5)

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Implémentation standard du Singleton

L'implémentation standard du Singleton consiste en une classe gérant elle-même son unique instance. Cela est réalisé au moyen d'un champ privé statique contenant l'instance et d'une méthode publique statique qui crée l'instance privée si elle n'existe pas puis la retourne.

En voici la représentation UML.

Diagramme UML

Cela ne pose aucun problème sur les dernières versions de Delphi.

Il existe d'ailleurs plusieurs discussions sur le sujet.

En voici une en particulier :

Variables globales section implémentation et objet singleton

Et voici, le code suggéré par Paul TOTH dans cette discussion :

Implémentation sur une version récente de Delphi
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
unit MonUnit;
 
interface
 
type
  TMyObject = class
    class var Instance: TMyObject;
    class function GetInstance: TMyObject;
  end;
 
implementation
 
function TMyObject.GetInstance: TMyObject;
begin
  if Instance = nil then
   Instance := TMyObject.Create;
  Result := Instance;
end;

Sauf qu'avec les versions plus anciennes de Delphi, les champs statiques ne sont pas autorisés et provoquent une erreur de compilation.

Image non disponible

Il va donc falloir stocker l'instance ailleurs.

II. Utilisation d'une variable globale

Puisque l'instance ne peut pas être stockée dans la classe. La seule option qui reste consiste à la placer ailleurs dans l'unité. Il faut juste savoir où.

Le choix le plus simple réside dans l'utilisation d'une variable globale accessible de n'importe où. Voici par exemple un singleton censé contenir des informations sur une configuration pour se connecter à une aide en ligne.

Singleton à l'aide d'une variable globale
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
unit GlobalVariableSingleton;

interface

type

  TOnlineHelpConfiguration = class
  private
    FUri : String;
    FOffer : String;
    FVersion : String;
  public
    property Uri : String read FUri write FUri;
    property Offer : String read FOffer write FOffer;
    property Version : String read FVersion write FVersion;
  end;

var
  OnlineHelpConfiguration : TOnlineHelpConfiguration;

implementation
uses
    SysUtils // FreeAndNil
  ;

initialization
  OnlineHelpConfiguration := TOnlineHelpConfiguration.Create;

finalization
  FreeAndNil(OnlineHelpConfiguration);

end.

L'avantage de cette méthode est qu'elle est vraiment très simple à mettre en œuvre. Elle s'accompagne malheureusement de défauts non négligeables :

  • l'objet est public et peut donc potentiellement être libéré provoquant une violation d'accès lors de sa prochaine utilisation ;
  • le type est accessible directement, ce qui implique que rien n'empêche la création d'une autre instance ;
  • l'objet est créé même si on n'en a jamais besoin.

III. Utilisation d'une fonction globale

Afin de régler le problème d'accessibilité et de chargement inutile, on peut confier la création de l'objet à une fonction qui vérifiera si l'objet est instancié avant de le créer et qui fournira l'instance en retour.

Singleton à l'aide d'une fonction globale
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
unit GlobalFunctionSingleton;

interface

type

  TOnlineHelpConfiguration = class
  private
    FUri : String;
    FOffer : String;
    FVersion : String;
  public
    property Uri : String read FUri write FUri;
    property Offer : String read FOffer write FOffer;
    property Version : String read FVersion write FVersion;
  end;

  function OnlineHelpConfiguration : TOnlineHelpConfiguration;

implementation
uses
    SysUtils // FreeAndNil
  ;

var
  HiddenOnlineHelpConfiguration : TOnlineHelpConfiguration;

  function OnlineHelpConfiguration : TOnlineHelpConfiguration;
  begin
    if not(Assigned(HiddenOnlineHelpConfiguration)) then
      HiddenOnlineHelpConfiguration := TOnlineHelpConfiguration.Create;

    Result := HiddenOnlineHelpConfiguration;
  end;


initialization

finalization
  FreeAndNil(HiddenOnlineHelpConfiguration);

end.

C'est mieux, la fonction permet d'instancier l'objet uniquement lorsque c'est nécessaire bien que cela n'empêche en rien l'instanciation via le constructeur de la classe directement.

À première vue, l'objet déclaré dans la partie implémentation ne semble pas accessible, mais c'est une fausse impression, car la fonction renvoie un pointeur sur cet objet à partir duquel sa libération est toujours possible. En voyant la manière dont est créée l'instance d'objet, on est tenté de penser que sa libération ne pose pas de problème, car il sera recréé au prochain appel. Le problème c'est que l'objet pointe toujours sur une adresse en mémoire bien qu'elle ne soit plus accessible et il est toujours considéré comme assigné alors qu'il ne l'est plus. La violation d'accès est inévitable. Cette méthode pose encore problème.

Notez que l'on peut remplacer la fonction globale par une approche un peu plus orientée objet via une méthode statique. Le résultat sera rigoureusement identique. Le code ci-dessous présente uniquement les changements apportés (le reste ne bouge pas).

Implémentation avec une méthode statique
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
// Dans la partie interface
TOnlineHelpConfiguration = class
private
  FUri : String;
  FOffer : String;
  FVersion : String;
public
  class function GetInstance : TOnlineHelpConfiguration;

  property Uri : String read FUri write FUri;
  property Offer : String read FOffer write FOffer;
  property Version : String read FVersion write FVersion;
end;

// Dans la partie implémentation
class function TOnlineHelpConfiguration.GetInstance: TOnlineHelpConfiguration;
begin
  if not(Assigned(HiddenOnlineHelpConfiguration)) then
      HiddenOnlineHelpConfiguration := TOnlineHelpConfiguration.Create;

    Result := HiddenOnlineHelpConfiguration;
end;

IV. Utilisation de l'héritage

Toute classe dans Delphi hérite obligatoirement de la classe ancêtre TObject. Cette classe ancêtre possède deux méthodes virtuelles en particulier que l'on peut surcharger pour créer ou libérer une instance. Il s'agit des méthodes NewInstance et FreeInstance. Montrer le code source de TObject ne ferait que compliquer inutilement ce tutoriel. Néanmoins, sa lecture est intéressante, car elle permet de constater que NewInstance fait appel à InitInstance pour rechercher son pointeur interne dans le gestionnaire de mémoire, créer une instance si la recherche est infructueuse ou bien retourner ce pointeur s'il a été trouvé. Elle fait donc exactement ce que nous voulons. En plus elle est statique, ce qui nous rapproche un peu plus de l'implémentation standard du singleton. FreeInstance libère la mémoire allouée, ce qui implique que si nous voulons garder toujours la même instance, il faudra appeler cette méthode uniquement lorsque cela sera réellement nécessaire.

Singleton géré par la classe
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
unit ManagedByClassSingleton;

interface

type

  TOnlineHelpConfiguration = class
  private
    FUri : String;
    FOffer : String;
    FVersion : String;
  public
    class function NewInstance : TObject; override;
    procedure FreeInstance; override;
    
    property Uri : String read FUri write FUri;
    property Offer : String read FOffer write FOffer;
    property Version : String read FVersion write FVersion;

  end;

implementation
uses
    SysUtils // FreeAndNil
  ;

var
  HiddenOnlineHelpConfiguration : TObject;
  MustFreeInstance : Boolean;


{ TOnlineHelpConfiguration }

class function TOnlineHelpConfiguration.NewInstance: TObject;
begin
  if not(Assigned(HiddenOnlineHelpConfiguration)) then
    HiddenOnlineHelpConfiguration := inherited NewInstance;

  Result := HiddenOnlineHelpConfiguration;
end;

procedure TOnlineHelpConfiguration.FreeInstance;
begin
  if (MustFreeInstance) then
    inherited FreeInstance;
end;

initialization
  MustFreeInstance := False;

finalization
  MustFreeInstance := True;
  FreeAndNil(HiddenOnlineHelpConfiguration);

end.

Ici, nous constatons que la classe peut toujours être instanciée directement, la différence réside dans le fait que la construction de l'objet va faire appel à la méthode NewInstance et donc rechercher en mémoire s'il n'y a pas déjà un pointeur sur l'objet et cela si notre propre objet caché n'est pas initialisé. Sa libération va faire de même avec la méthode FreeInstance. Sauf que la véritable libération n'est effectuée que lorsque le booléen (inaccessible de l'extérieur, car dans la partie implémentation) passera à « Vrai », c'est-à-dire lorsque l'unité sera déchargée (lorsque le programme s'arrêtera). Nous avons donc un objet qui est créé uniquement lorsque nous en avons besoin et qui ne sera pas libéré avant la fermeture du programme. Mission accomplie.

V. Singleton avancé

Pour des raisons de praticité, on peut choisir de publier un contrat à la place d'une classe. En effet, en fournissant une interface, on libère le consommateur du singleton d'une contrainte : celui-ci peut ignorer qu'il s'agit d'un singleton et l'utiliser comme n'importe quel objet (avec un Create, un try…finally et un Free). On n'a pas à se soucier de la libération d'une interface.

Singleton avancé
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
unit AdvancedSingleton;

interface

type

  ISingleton = interface
  ['{36771100-7CB3-4550-A444-BFC27A643DF6}']
  end;

  IOnlineHelpConfiguration = interface(ISingleton)
  ['{870E1B29-08D3-4395-BE41-B190072264E5}']
    function GetUri : String;
    function GetOffer : String;
    function GetVersion : String;

    procedure SetUri(Const Value : String);
    procedure SetOffer(Const Value : String);
    procedure SetVersion(Const Value : String);

    property Uri : String read GetUri write SetUri;
    property Offer : String read GetOffer write SetOffer;
    property Version : String read GetVersion write SetVersion;
  end;

  function OnlineHelpConfiguration : IOnlineHelpConfiguration;

implementation
uses
    SyncObjs // TCriticalSection
  , SysUtils // FreeAndNil
  ;

type

  TOnlineHelpConfiguration = class(TInterfacedObject,IOnlineHelpConfiguration)
  private
    FUri : String;
    FOffer : String;
    FVersion : String;
  public
    function GetUri : String;
    function GetOffer : String;
    function GetVersion : String;

    procedure SetUri(Const Value : String);
    procedure SetOffer(Const Value : String);
    procedure SetVersion(Const Value : String);

    property Uri : String read GetUri write SetUri;
    property Offer : String read GetOffer write SetOffer;
    property Version : String read GetVersion write SetVersion;
  end;

  TOnlineHelpConfigurationProvider = class
  private
    FCriticalSection : TCriticalSection;
    FOnlineHelpConfiguration : IOnlineHelpConfiguration;
  public
    constructor Create;
    destructor Destroy; override;

    function GetInstance : IOnlineHelpConfiguration;
  end;

var
  Provider : TOnlineHelpConfigurationProvider;

function OnlineHelpConfiguration : IOnlineHelpConfiguration;
begin
  if not(Assigned(Provider)) then
    Provider := TOnlineHelpConfigurationProvider.Create;

  Result := Provider.GetInstance;
end;

{ TOnlineHelpConfiguration }

function TOnlineHelpConfiguration.GetUri: String;
begin
  Result := FUri;
end;

function TOnlineHelpConfiguration.GetOffer: String;
begin
  Result := FOffer;
end;

function TOnlineHelpConfiguration.GetVersion: String;
begin
  Result := FVersion;
end;

procedure TOnlineHelpConfiguration.SetUri(const Value: String);
begin
  FUri := Value;
end;

procedure TOnlineHelpConfiguration.SetOffer(const Value: String);
begin
  FOffer := Value;
end;

procedure TOnlineHelpConfiguration.SetVersion(const Value: String);
begin
  FVersion := Value;
end;

{ TOnlineHelpConfigurationProvider }

constructor TOnlineHelpConfigurationProvider.Create;
begin
  FOnlineHelpConfiguration := nil;
  FCriticalSection := TCriticalSection.Create;
end;

destructor TOnlineHelpConfigurationProvider.Destroy;
begin
  FreeAndNil(FCriticalSection);
  FOnlineHelpConfiguration := nil;
  inherited;
end;

function TOnlineHelpConfigurationProvider.GetInstance: IOnlineHelpConfiguration;
begin
  if not(Assigned(FOnlineHelpConfiguration)) then
  begin
    FCriticalSection.Enter;
    try
      // Nouvelle vérification pour gérer le cas  un thread aurait
      // attendu lors de l'instanciation initiale et entrerait ensuite
      if not(Assigned(FOnlineHelpConfiguration)) then
        FOnlineHelpConfiguration := TOnlineHelpConfiguration.Create;
    finally
      FCriticalSection.Leave;
    end;
  end;

  Result := FOnlineHelpConfiguration;
end;

initialization

finalization
  FreeAndNil(Provider);

end.

L'interface nous assure que le singleton ne sera jamais libéré par erreur, l'objet Provider s'occupe de créer l'instance uniquement au moment où on la sollicite et le singleton sera libéré lors du déchargement de l'unité.

Toujours dans l'optique de simplifier la consommation du singleton, la fonction globale d'accès est ici préférée à une méthode statique. Elle demeure cependant réalisable pour ceux qui voudraient se rapprocher du modèle objet.

L'objet Provider possède une section critique afin de s'assurer d'une unique instanciation, y compris dans un contexte multithread.

L'interface ISingleton n'apporte rien fonctionnellement. Elle est cependant importante pour signifier au consommateur que l'interface IOnlineHelpConfiguration répond au patron du singleton. L'image ci-dessous montre l'infobulle générée par Delphi au survol de la souris sur le type dans la déclaration des variables.

Image non disponible

Cette implémentation du singleton est, certes, la compliquée parmi celles présentées dans ce document, mais elle est (ce n'est que mon avis) la plus robuste et la plus simple à consommer.

VI. Consommation des différents singletons

Afin de voir fonctionnellement les différences entre les diverses implémentations du singleton, le plus simple consiste à créer une petite application de test.

L'image ci-dessous représente l'interface que j'ai choisie. Elle se présente sous la forme d'un groupe permettant la saisie des données du singleton (mais non éditable pour ne pas perturber les tests), d'un groupe de boutons radio permettant de choisir quel type d'implémentation tester et de trois boutons pour vérifier si les implémentations répondent aux caractéristiques d'un singleton. Ce n'est qu'une présentation parmi tant d'autres et je m'accorderai volontiers avec ceux qui estimeront que ces données ne devraient pas être saisies par l'utilisateur. Cela reste cependant plus simple à comprendre sans la problématique du chargement des données.

Image non disponible

Explications complémentaires :

Afin que les tests soient assez explicites, j'ai volontairement déclaré un booléen pour stocker le fait que des données ont déjà été stockées dans le singleton et ne pas le faire une deuxième fois (le but de la manœuvre sera expliqué en temps voulu).

Déclarations privées de la fenêtre principale
Sélectionnez
{ Déclarations privées }
FDataExistInGlobalVariableSingleton : Boolean;
FDataExistInGlobalFunctionSingleton : Boolean;
FDataExistInManagedByClassSingleton : Boolean;
FDataExistInAdvancedSingleton : Boolean;

procedure GlobalVariableSingletonShowData;
procedure GlobalFunctionSingletonShowData;
procedure ManagedByClassSingletonShowData;
procedure AdvancedSingletonShowData;

procedure GlobalVariableSingletonFree;
procedure GlobalFunctionSingletonFree;
procedure ManagedByClassSingletonFree;
procedure AdvancedSingletonFree;

procedure GlobalVariableSingletonGetTwoInstances;
procedure GlobalFunctionSingletonGetTwoInstances;
procedure ManagedByClassSingletonGetTwoInstances;
procedure AdvancedSingletonGetTwoInstances;

Ces booléens sont privés, de même que les procédures à appeler pour les tests, car ces éléments ne sont pas censés être appelés ailleurs que dans la fenêtre.

Le code ci-dessous montre l'affichage des données du singleton implémenté avec une variable globale. Le booléen s'assure que les données sont affectées une seule fois.

Affichage des données du singleton avec variable globale
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
procedure TMainForm.GlobalVariableSingletonShowData;
var Msg : String;
    Instance : GlobalVariableSingleton.TOnlineHelpConfiguration;
begin
  Instance := GlobalVariableSingleton.OnlineHelpConfiguration;
  if not(FDataExistInGlobalVariableSingleton) then
  begin
    Instance.Uri := Uri.Text;
    Instance.Offer := Offer.Text;
    Instance.Version := Version.Text;
    
    FDataExistInGlobalVariableSingleton := True;
  end;

  Msg := Format(MESSAGE_FORMAT,
    [Instance.Uri,
    Instance.Offer,
    Instance.Version]);

  MessageBox(Handle,PChar(Msg),PChar('Singleton Variable globale'),0);
end;

Le code ci-dessous montre l'affichage des données du singleton implémenté avec une fonction globale. Le booléen s'assure que les données sont affectées une seule fois.

Affichage des données du singleton avec fonction globale
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
procedure TMainForm.GlobalFunctionSingletonShowData;
var Msg : String;
    Instance : GlobalFunctionSingleton.TOnlineHelpConfiguration;
begin
  Instance := GlobalFunctionSingleton.OnlineHelpConfiguration;
  if not(FDataExistInGlobalFunctionSingleton) then
  begin
    Instance.Uri := Uri.Text;
    Instance.Offer := Offer.Text;
    Instance.Version := Version.Text;

    FDataExistInGlobalFunctionSingleton := True;
  end;

  Msg := Format(MESSAGE_FORMAT,
    [Instance.Uri,
    Instance.Offer,
    Instance.Version]);

  MessageBox(Handle,PChar(Msg),PChar('Singleton Fonction globale'),0);
end;

Le code ci-dessous montre l'affichage des données du singleton implémenté à l'aide de l'héritage. Le booléen s'assure que les données sont affectées une seule fois.

Affichage des données du singleton par héritage
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
procedure TMainForm.ManagedByClassSingletonShowData;
var Msg : String;
    Instance : ManagedByClassSingleton.TOnlineHelpConfiguration;
begin
  Instance := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;
  try
    if not(FDataExistInManagedByClassSingleton) then
    begin
      Instance.Uri := Uri.Text;
      Instance.Offer := Offer.Text;
      Instance.Version := Version.Text;

      FDataExistInManagedByClassSingleton := True;
    end;

    Msg := Format(MESSAGE_FORMAT,
      [Instance.Uri,
      Instance.Offer,
      Instance.Version]);
  finally
    FreeAndNil(Instance);
  end;

  MessageBox(Handle,PChar(Msg),PChar('Singleton géré par la classe'),0);
end;

Le code ci-dessous montre l'affichage des données du singleton avancé. Le booléen s'assure que les données sont affectées une seule fois.

Affichage des données du singleton avancé
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
procedure TMainForm.AdvancedSingletonShowData;
var Msg : String;
    Instance : AdvancedSingleton.IOnlineHelpConfiguration;
begin
  Instance := AdvancedSingleton.OnlineHelpConfiguration;
  if not(FDataExistInAdvancedSingleton) then
  begin
    Instance.Uri := Uri.Text;
    Instance.Offer := Offer.Text;
    Instance.Version := Version.Text;

    FDataExistInAdvancedSingleton := True;
  end;

  Msg := Format(MESSAGE_FORMAT,
    [Instance.Uri,
    Instance.Offer,
    Instance.Version]);

  MessageBox(Handle,PChar(Msg),PChar('Singleton avancé'),0);
end;

Le code ci-dessous montre le code derrière le premier bouton.

Appel des procédures d'affichage
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
procedure TMainForm.TryToShowSingletonDataButtonClick(Sender: TObject);
begin
  case (ImplementationChoice.ItemIndex) of
    0 : GlobalVariableSingletonShowData;
    1 : GlobalFunctionSingletonShowData;
    2 : ManagedByClassSingletonShowData;
    3 : AdvancedSingletonShowData;
  end;
end;

Ces quelques lignes permettent déjà de vérifier que les données s'affichent bien. Jusque-là, il n'y a aucun problème.

Image non disponible

Que se passe-t-il si on essaie de libérer tous ces singletons ?

Le code ci-dessous tente de libérer le singleton implémenté avec une variable globale.

Libération du singleton avec variable globale
Sélectionnez
1.
2.
3.
4.
procedure TMainForm.GlobalVariableSingletonFree;
begin
  GlobalVariableSingleton.OnlineHelpConfiguration.Free;
end;

Le code ci-dessous tente de libérer le singleton implémenté avec une fonction globale.

Libération du singleton avec fonction globale
Sélectionnez
1.
2.
3.
4.
procedure TMainForm.GlobalFunctionSingletonFree;
begin
  GlobalFunctionSingleton.OnlineHelpConfiguration.Free;
end;

Le code ci-dessous tente de libérer le singleton géré par la classe via l'héritage.

Libération du singleton géré par la classe
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
procedure TMainForm.ManagedByClassSingletonFree;
var Instance : ManagedByClassSingleton.TOnlineHelpConfiguration;
begin
  Instance := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;
  try
  finally
    FreeAndNil(Instance);
  end;
end;

Le code ci-dessous tente de libérer le singleton avancé.

Libération du singleton avancé
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
procedure TMainForm.AdvancedSingletonFree;
var Instance : AdvancedSingleton.IOnlineHelpConfiguration;
begin
  Instance := AdvancedSingleton.OnlineHelpConfiguration;
  try
  finally
    { On ne libère pas une interface. On peut la passer à nil si on veut
      mais cela sera fait automatiquement lors de la sortie de la procédure }
    Instance := nil;
  end;
end;

Le code ci-dessous montre le code derrière le second bouton.

Appel des procédures de libération
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
procedure TMainForm.TryToFreeSingletonButtonClick(Sender: TObject);
begin
  case (ImplementationChoice.ItemIndex) of
    0 : GlobalVariableSingletonFree;
    1 : GlobalFunctionSingletonFree;
    2 : ManagedByClassSingletonFree;
    3 : AdvancedSingletonFree;
  end;
end;

On remarque, après la libération des deux premiers singletons, que le programme devient instable. Pour les deux autres, l'affichage des données se fait bien malgré la présence des booléens empêchant le renseignement des propriétés et dont on peut, à présent, constater l'importance puisqu'elle prouve l'unicité de l'instance.

Image non disponible

Comme vérifié précédemment, les deux dernières implémentations répondent à l'unicité du singleton. Les violations d'accès déclenchées par les deux premières suggèrent que ce n'est pas leur cas.

Le code ci-dessous tente de créer deux instances du singleton implémenté à l'aide d'une variable globale.

Deux instances du singleton avec variable globale
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
procedure TMainForm.GlobalVariableSingletonGetTwoInstances;
var Instance1, Instance2 : GlobalVariableSingleton.TOnlineHelpConfiguration;
    Msg : String;
begin
  Instance1 := GlobalVariableSingleton.TOnlineHelpConfiguration.Create;
  Instance2 := GlobalVariableSingleton.TOnlineHelpConfiguration.Create;
  try
    if (Instance1 = Instance2) then Msg := 'C''est la même instance.'
    else Msg := 'Ce sont deux instances différentes.';
  finally
    FreeAndNil(Instance1);
    FreeAndNil(Instance2);
  end;

  MessageBox(Handle,PChar(Msg),PChar('Singleton Variable globale'),0);
end;

Le code ci-dessous tente de créer deux instances du singleton implémenté à l'aide d'une fonction globale.

Deux instances du singleton avec fonction globale
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
procedure TMainForm.GlobalFunctionSingletonGetTwoInstances;
var Instance1, Instance2 : GlobalFunctionSingleton.TOnlineHelpConfiguration;
    Msg : String;
begin
  Instance1 := GlobalFunctionSingleton.TOnlineHelpConfiguration.Create;
  Instance2 := GlobalFunctionSingleton.TOnlineHelpConfiguration.Create;
  try
    if (Instance1 = Instance2) then Msg := 'C''est la même instance.'
    else Msg := 'Ce sont deux instances différentes.';
  finally
    FreeAndNil(Instance1);
    FreeAndNil(Instance2);
  end;

  MessageBox(Handle,PChar(Msg),PChar('Singleton Fonction globale'),0);
end;

Le code ci-dessous tente de créer deux instances du singleton géré par la classe.

Deux instances du singleton géré par la classe
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
procedure TMainForm.ManagedByClassSingletonGetTwoInstances;
var Instance1, Instance2 : ManagedByClassSingleton.TOnlineHelpConfiguration;
    Msg : String;
begin
  Instance1 := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;
  Instance2 := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;
  try
    if (Instance1 = Instance2) then Msg := 'C''est la même instance.'
    else Msg := 'Ce sont deux instances différentes.';
  finally
    FreeAndNil(Instance1);
    FreeAndNil(Instance2);
  end;

  MessageBox(Handle,PChar(Msg),PChar('Singleton géré par la classe'),0);
end;

Le code ci-dessous tente de créer deux instances du singleton avancé.

Deux instances du singleton avancé
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
procedure TMainForm.AdvancedSingletonGetTwoInstances;
var Instance1, Instance2 : IOnlineHelpConfiguration;
    Msg : String;
begin
  Instance1 := AdvancedSingleton.OnlineHelpConfiguration;
  Instance2 := AdvancedSingleton.OnlineHelpConfiguration;

  if (Instance1 = Instance2) then Msg := 'C''est la même instance.'
  else Msg := 'Ce sont deux instances différentes.';

  MessageBox(Handle,PChar(Msg),PChar('Singleton avancé'),0);
end;

Le code ci-dessous montre le code derrière le troisième bouton.

Appel des procédures de double instanciation
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
procedure TMainForm.TryGetTwoInstancesButtonClick(Sender: TObject);
begin
  case (ImplementationChoice.ItemIndex) of
    0 : GlobalVariableSingletonGetTwoInstances;
    1 : GlobalFunctionSingletonGetTwoInstances;
    2 : ManagedByClassSingletonGetTwoInstances;
    3 : AdvancedSingletonGetTwoInstances;
  end;
end;

Image non disponible

Comme prévu, l'implémentation avec une variable globale et celle avec une fonction globale ne respectent pas l'unicité alors que l'implémentation gérée par la classe et l'implémentation avancée le font.

VII. Exemples connus dans la RTL/VCL

Lorsqu'on développe dans un IDE, un nombre important de routines et de classes sont fournies nativement. Delphi ne fait pas exception et propose quelques singletons.

C'est le cas par exemple des classes TApplication, TScreen ou encore TMouse implémentées au moyen de variables globales.

Extrait de l'unité Forms :

Singletons de Delphi
Sélectionnez
{ Global objects }

var
  Application: TApplication;
  Screen: TScreen;

…
implementation

Extrait de l'unité Controls :

Singletons de Delphi
Sélectionnez
var
  Mouse: TMouse;

…
implementationprocedure InitControls;
var
  UserHandle: HMODULE;
begin
  … 
  Mouse := TMouse.Create;
  Screen := TScreen.Create(nil);
  Application := TApplication.Create(nil);
  … 
end;

…
initialization
  NewStyleControls := Lo(GetVersion) >= 4;
  InitControls;

…

On constate que les variables Application et Screen sont déclarées dans l'unité Forms et initialisées dans l'unité Controls. La variable Mouse est déclarée et initialisée dans l'unité Controls.

Une implémentation passant par une fonction globale est utilisée, entre autres, pour la classe TPrinter.

Extrait de l'unité Printers :

Singletons de Delphi
Sélectionnez
function Printer: TPrinter;

…
implementation

uses Consts;

var
  FPrinter: TPrinter = nil;

…

function Printer: TPrinter;
begin
  if FPrinter = nil then FPrinter := TPrinter.Create;
  Result := FPrinter;
end;

…
initialization

finalization
  FPrinter.Free;

VIII. Remerciements

Je tiens à remercier Alcatîz pour m'avoir invité à écrire ces pages (ce fut une première, mais non moins enrichissante expérience) ainsi que pour les réponses à toutes les questions que je lui ai posées sur l'outil, ShaiLeTroll pour ces nombreux conseils qui m'ont permis d'améliorer ce tutoriel, ainsi que Roland Chastain,Didier Mamere, ClaudeLELOUP et f-leb pour la correction de mes fautes d'orthographe.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2015 Jérémy LAURENT. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.