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 :
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.
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.
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.
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).
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.
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.
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 où 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.
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 }
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.
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.
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.
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.
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.
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.
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.
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.
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.
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é.
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.
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.
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.
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.
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.
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é.
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.
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;
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 :
{ Global objects }
var
Application: TApplication;
Screen: TScreen;
…
implementationExtrait de l'unité Controls :
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 :
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.