Implémentation d'un Singleton avec Delphi 7

Jérémy LAURENT

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.

Commentez

- Titre : Implémentation d'un Singleton avec Delphi 7

- Auteur : Jérémy LAURENT

- Parution : 27 janvier 2015

- Mise à jour : 2 février 2015

- Public visé :

- Licence : 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.

Sommaire

- I. Implémentation standard du Singleton

- II. Utilisation d'une variable globale

- III. Utilisation d'une fonction globale

- IV. Utilisation de l'héritage

- V. Singleton avancé

- VI. Consommation des différents singletons

- VII. Exemples connus dans la RTL/VCL

- VIII. Remerciements

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.

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

1. unit MonUnit;

3. interface

5. type

6. TMyObject = class

7. class var Instance: TMyObject;

8. class function GetInstance: TMyObject;

9. end;

11. implementation

13. function TMyObject.GetInstance: TMyObject;

14. begin

15. if Instance = nil then

16. Instance := TMyObject.Create;

17. Result := Instance;

18. end;

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

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

1. unit GlobalVariableSingleton;

3. interface

5. type

7. TOnlineHelpConfiguration = class

8. private

9. FUri : String;

10. FOffer : String;

11. FVersion : String;

12. public

13. property Uri : String read FUri write FUri;

14. property Offer : String read FOffer write FOffer;

15. property Version : String read FVersion write FVersion;

16. end;

18. var

19. OnlineHelpConfiguration : TOnlineHelpConfiguration;

21. implementation

22. uses

23. SysUtils // FreeAndNil

24. ;

26. initialization

27. OnlineHelpConfiguration := TOnlineHelpConfiguration.Create;

29. finalization

30. FreeAndNil(OnlineHelpConfiguration);

32. 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

1. unit GlobalFunctionSingleton;

3. interface

5. type

7. TOnlineHelpConfiguration = class

8. private

9. FUri : String;

10. FOffer : String;

11. FVersion : String;

12. public

13. property Uri : String read FUri write FUri;

14. property Offer : String read FOffer write FOffer;

15. property Version : String read FVersion write FVersion;

16. end;

18. function OnlineHelpConfiguration : TOnlineHelpConfiguration;

20. implementation

21. uses

22. SysUtils // FreeAndNil

23. ;

25. var

26. HiddenOnlineHelpConfiguration : TOnlineHelpConfiguration;

28. function OnlineHelpConfiguration : TOnlineHelpConfiguration;

29. begin

30. if not(Assigned(HiddenOnlineHelpConfiguration)) then

31. HiddenOnlineHelpConfiguration := TOnlineHelpConfiguration.Create;

33. Result := HiddenOnlineHelpConfiguration;

34. end;

37. initialization

39. finalization

40. FreeAndNil(HiddenOnlineHelpConfiguration);

42. 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

1. // Dans la partie interface

2. TOnlineHelpConfiguration = class

3. private

4. FUri : String;

5. FOffer : String;

6. FVersion : String;

7. public

8. class function GetInstance : TOnlineHelpConfiguration;

10. property Uri : String read FUri write FUri;

11. property Offer : String read FOffer write FOffer;

12. property Version : String read FVersion write FVersion;

13. end;

15. // Dans la partie implémentation

16. class function TOnlineHelpConfiguration.GetInstance: TOnlineHelpConfiguration;

17. begin

18. if not(Assigned(HiddenOnlineHelpConfiguration)) then

19. HiddenOnlineHelpConfiguration := TOnlineHelpConfiguration.Create;

21. Result := HiddenOnlineHelpConfiguration;

22. 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

1. unit ManagedByClassSingleton;

3. interface

5. type

7. TOnlineHelpConfiguration = class

8. private

9. FUri : String;

10. FOffer : String;

11. FVersion : String;

12. public

13. class function NewInstance : TObject; override;

14. procedure FreeInstance; override;

16. property Uri : String read FUri write FUri;

17. property Offer : String read FOffer write FOffer;

18. property Version : String read FVersion write FVersion;

20. end;

22. implementation

23. uses

24. SysUtils // FreeAndNil

25. ;

27. var

28. HiddenOnlineHelpConfiguration : TObject;

29. MustFreeInstance : Boolean;

32. { TOnlineHelpConfiguration }

34. class function TOnlineHelpConfiguration.NewInstance: TObject;

35. begin

36. if not(Assigned(HiddenOnlineHelpConfiguration)) then

37. HiddenOnlineHelpConfiguration := inherited NewInstance;

39. Result := HiddenOnlineHelpConfiguration;

40. end;

42. procedure TOnlineHelpConfiguration.FreeInstance;

43. begin

44. if (MustFreeInstance) then

45. inherited FreeInstance;

46. end;

48. initialization

49. MustFreeInstance := False;

51. finalization

52. MustFreeInstance := True;

53. FreeAndNil(HiddenOnlineHelpConfiguration);

55. 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é

1. unit AdvancedSingleton;

3. interface

5. type

7. ISingleton = interface

8. ['{36771100-7CB3-4550-A444-BFC27A643DF6}']

9. end;

11. IOnlineHelpConfiguration = interface(ISingleton)

12. ['{870E1B29-08D3-4395-BE41-B190072264E5}']

13. function GetUri : String;

14. function GetOffer : String;

15. function GetVersion : String;

17. procedure SetUri(Const Value : String);

18. procedure SetOffer(Const Value : String);

19. procedure SetVersion(Const Value : String);

21. property Uri : String read GetUri write SetUri;

22. property Offer : String read GetOffer write SetOffer;

23. property Version : String read GetVersion write SetVersion;

24. end;

26. function OnlineHelpConfiguration : IOnlineHelpConfiguration;

28. implementation

29. uses

30. SyncObjs // TCriticalSection

31. , SysUtils // FreeAndNil

32. ;

34. type

36. TOnlineHelpConfiguration = class(TInterfacedObject,IOnlineHelpConfiguration)

37. private

38. FUri : String;

39. FOffer : String;

40. FVersion : String;

41. public

42. function GetUri : String;

43. function GetOffer : String;

44. function GetVersion : String;

46. procedure SetUri(Const Value : String);

47. procedure SetOffer(Const Value : String);

48. procedure SetVersion(Const Value : String);

50. property Uri : String read GetUri write SetUri;

51. property Offer : String read GetOffer write SetOffer;

52. property Version : String read GetVersion write SetVersion;

53. end;

55. TOnlineHelpConfigurationProvider = class

56. private

57. FCriticalSection : TCriticalSection;

58. FOnlineHelpConfiguration : IOnlineHelpConfiguration;

59. public

60. constructor Create;

61. destructor Destroy; override;

63. function GetInstance : IOnlineHelpConfiguration;

64. end;

66. var

67. Provider : TOnlineHelpConfigurationProvider;

69. function OnlineHelpConfiguration : IOnlineHelpConfiguration;

70. begin

71. if not(Assigned(Provider)) then

72. Provider := TOnlineHelpConfigurationProvider.Create;

74. Result := Provider.GetInstance;

75. end;

77. { TOnlineHelpConfiguration }

79. function TOnlineHelpConfiguration.GetUri: String;

80. begin

81. Result := FUri;

82. end;

84. function TOnlineHelpConfiguration.GetOffer: String;

85. begin

86. Result := FOffer;

87. end;

89. function TOnlineHelpConfiguration.GetVersion: String;

90. begin

91. Result := FVersion;

92. end;

94. procedure TOnlineHelpConfiguration.SetUri(const Value: String);

95. begin

96. FUri := Value;

97. end;

99. procedure TOnlineHelpConfiguration.SetOffer(const Value: String);

100. begin

101. FOffer := Value;

102. end;

104. procedure TOnlineHelpConfiguration.SetVersion(const Value: String);

105. begin

106. FVersion := Value;

107. end;

109. { TOnlineHelpConfigurationProvider }

111. constructor TOnlineHelpConfigurationProvider.Create;

112. begin

113. FOnlineHelpConfiguration := nil;

114. FCriticalSection := TCriticalSection.Create;

115. end;

117. destructor TOnlineHelpConfigurationProvider.Destroy;

118. begin

119. FreeAndNil(FCriticalSection);

120. FOnlineHelpConfiguration := nil;

121. inherited;

122. end;

124. function TOnlineHelpConfigurationProvider.GetInstance: IOnlineHelpConfiguration;

125. begin

126. if not(Assigned(FOnlineHelpConfiguration)) then

127. begin

128. FCriticalSection.Enter;

129. try

130. // Nouvelle vérification pour gérer le cas où un thread aurait

131. // attendu lors de l'instanciation initiale et entrerait ensuite

132. if not(Assigned(FOnlineHelpConfiguration)) then

133. FOnlineHelpConfiguration := TOnlineHelpConfiguration.Create;

134. finally

135. FCriticalSection.Leave;

136. end;

137. end;

139. Result := FOnlineHelpConfiguration;

140. end;

142. initialization

144. finalization

145. FreeAndNil(Provider);

147. 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.

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.

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

{ 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

1. procedure TMainForm.GlobalVariableSingletonShowData;

2. var Msg : String;

3. Instance : GlobalVariableSingleton.TOnlineHelpConfiguration;

4. begin

5. Instance := GlobalVariableSingleton.OnlineHelpConfiguration;

6. if not(FDataExistInGlobalVariableSingleton) then

7. begin

8. Instance.Uri := Uri.Text;

9. Instance.Offer := Offer.Text;

10. Instance.Version := Version.Text;

12. FDataExistInGlobalVariableSingleton := True;

13. end;

15. Msg := Format(MESSAGE_FORMAT,

16. [Instance.Uri,

17. Instance.Offer,

18. Instance.Version]);

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

21. 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

1. procedure TMainForm.GlobalFunctionSingletonShowData;

2. var Msg : String;

3. Instance : GlobalFunctionSingleton.TOnlineHelpConfiguration;

4. begin

5. Instance := GlobalFunctionSingleton.OnlineHelpConfiguration;

6. if not(FDataExistInGlobalFunctionSingleton) then

7. begin

8. Instance.Uri := Uri.Text;

9. Instance.Offer := Offer.Text;

10. Instance.Version := Version.Text;

12. FDataExistInGlobalFunctionSingleton := True;

13. end;

15. Msg := Format(MESSAGE_FORMAT,

16. [Instance.Uri,

17. Instance.Offer,

18. Instance.Version]);

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

21. 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

1. procedure TMainForm.ManagedByClassSingletonShowData;

2. var Msg : String;

3. Instance : ManagedByClassSingleton.TOnlineHelpConfiguration;

4. begin

5. Instance := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;

6. try

7. if not(FDataExistInManagedByClassSingleton) then

8. begin

9. Instance.Uri := Uri.Text;

10. Instance.Offer := Offer.Text;

11. Instance.Version := Version.Text;

13. FDataExistInManagedByClassSingleton := True;

14. end;

16. Msg := Format(MESSAGE_FORMAT,

17. [Instance.Uri,

18. Instance.Offer,

19. Instance.Version]);

20. finally

21. FreeAndNil(Instance);

22. end;

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

25. 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é

1. procedure TMainForm.AdvancedSingletonShowData;

2. var Msg : String;

3. Instance : AdvancedSingleton.IOnlineHelpConfiguration;

4. begin

5. Instance := AdvancedSingleton.OnlineHelpConfiguration;

6. if not(FDataExistInAdvancedSingleton) then

7. begin

8. Instance.Uri := Uri.Text;

9. Instance.Offer := Offer.Text;

10. Instance.Version := Version.Text;

12. FDataExistInAdvancedSingleton := True;

13. end;

15. Msg := Format(MESSAGE_FORMAT,

16. [Instance.Uri,

17. Instance.Offer,

18. Instance.Version]);

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

21. end;

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

Appel des procédures d'affichage

1. procedure TMainForm.TryToShowSingletonDataButtonClick(Sender: TObject);

2. begin

3. case (ImplementationChoice.ItemIndex) of

4. 0 : GlobalVariableSingletonShowData;

5. 1 : GlobalFunctionSingletonShowData;

6. 2 : ManagedByClassSingletonShowData;

7. 3 : AdvancedSingletonShowData;

8. end;

9. 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.

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

1. procedure TMainForm.GlobalVariableSingletonFree;

2. begin

3. GlobalVariableSingleton.OnlineHelpConfiguration.Free;

4. end;

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

Libération du singleton avec fonction globale

1. procedure TMainForm.GlobalFunctionSingletonFree;

2. begin

3. GlobalFunctionSingleton.OnlineHelpConfiguration.Free;

4. 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

1. procedure TMainForm.ManagedByClassSingletonFree;

2. var Instance : ManagedByClassSingleton.TOnlineHelpConfiguration;

3. begin

4. Instance := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;

5. try

6. finally

7. FreeAndNil(Instance);

8. end;

9. end;

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

Libération du singleton avancé

1. procedure TMainForm.AdvancedSingletonFree;

2. var Instance : AdvancedSingleton.IOnlineHelpConfiguration;

3. begin

4. Instance := AdvancedSingleton.OnlineHelpConfiguration;

5. try

6. finally

7. { On ne libère pas une interface. On peut la passer à nil si on veut

8. mais cela sera fait automatiquement lors de la sortie de la procédure }

9. Instance := nil;

10. end;

11. end;

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

Appel des procédures de libération

1. procedure TMainForm.TryToFreeSingletonButtonClick(Sender: TObject);

2. begin

3. case (ImplementationChoice.ItemIndex) of

4. 0 : GlobalVariableSingletonFree;

5. 1 : GlobalFunctionSingletonFree;

6. 2 : ManagedByClassSingletonFree;

7. 3 : AdvancedSingletonFree;

8. end;

9. 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.

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

1. procedure TMainForm.GlobalVariableSingletonGetTwoInstances;

2. var Instance1, Instance2 : GlobalVariableSingleton.TOnlineHelpConfiguration;

3. Msg : String;

4. begin

5. Instance1 := GlobalVariableSingleton.TOnlineHelpConfiguration.Create;

6. Instance2 := GlobalVariableSingleton.TOnlineHelpConfiguration.Create;

7. try

8. if (Instance1 = Instance2) then Msg := 'C''est la même instance.'

9. else Msg := 'Ce sont deux instances différentes.';

10. finally

11. FreeAndNil(Instance1);

12. FreeAndNil(Instance2);

13. end;

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

16. 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

1. procedure TMainForm.GlobalFunctionSingletonGetTwoInstances;

2. var Instance1, Instance2 : GlobalFunctionSingleton.TOnlineHelpConfiguration;

3. Msg : String;

4. begin

5. Instance1 := GlobalFunctionSingleton.TOnlineHelpConfiguration.Create;

6. Instance2 := GlobalFunctionSingleton.TOnlineHelpConfiguration.Create;

7. try

8. if (Instance1 = Instance2) then Msg := 'C''est la même instance.'

9. else Msg := 'Ce sont deux instances différentes.';

10. finally

11. FreeAndNil(Instance1);

12. FreeAndNil(Instance2);

13. end;

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

16. 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

1. procedure TMainForm.ManagedByClassSingletonGetTwoInstances;

2. var Instance1, Instance2 : ManagedByClassSingleton.TOnlineHelpConfiguration;

3. Msg : String;

4. begin

5. Instance1 := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;

6. Instance2 := ManagedByClassSingleton.TOnlineHelpConfiguration.Create;

7. try

8. if (Instance1 = Instance2) then Msg := 'C''est la même instance.'

9. else Msg := 'Ce sont deux instances différentes.';

10. finally

11. FreeAndNil(Instance1);

12. FreeAndNil(Instance2);

13. end;

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

16. end;

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

Deux instances du singleton avancé

1. procedure TMainForm.AdvancedSingletonGetTwoInstances;

2. var Instance1, Instance2 : IOnlineHelpConfiguration;

3. Msg : String;

4. begin

5. Instance1 := AdvancedSingleton.OnlineHelpConfiguration;

6. Instance2 := AdvancedSingleton.OnlineHelpConfiguration;

8. if (Instance1 = Instance2) then Msg := 'C''est la même instance.'

9. else Msg := 'Ce sont deux instances différentes.';

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

12. end;

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

Appel des procédures de double instanciation

1. procedure TMainForm.TryGetTwoInstancesButtonClick(Sender: TObject);

2. begin

3. case (ImplementationChoice.ItemIndex) of

4. 0 : GlobalVariableSingletonGetTwoInstances;

5. 1 : GlobalFunctionSingletonGetTwoInstances;

6. 2 : ManagedByClassSingletonGetTwoInstances;

7. 3 : AdvancedSingletonGetTwoInstances;

8. end;

9. end;

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

{ Global objects }

var
Application: TApplication;
Screen: TScreen;

…
implementation

Extrait de l'unité Controls :

Singletons de Delphi

var
Mouse: TMouse;

…
implementation

…
procedure 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

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.