Depuis peu retour en Delphi !
Après un passage en C++Buider 2007, XE2 et XE3
Je reprends du Delphi XE2 et je découvre les nouveautés que je n'avais pas en Delphi 7 !

M'étant habitué au Template du C++, je me suis lancé dans les génériques !

Dans la société ou je travaille, j'ai trouvé une Pattern singleton utilisant les génériques, dommage que l'auteur d'origine Moritz Beutel n'ait pas été mentionné dans le code de mon prédécesseur

De la façon qu'elle a été utilisé, il était d'une grande simplicité de créer plusieurs singletons !
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
var
  BiduleSingleton : TSingletonInstance<TBidule>;
  BiduleDoublon : TSingletonInstance<TBidule>;
BiduleSingleton et BiduleDoublon sont des variables globales, c'est la syntaxe non OO comme pour Printer()
Dommage, il existe aujourd'hui les class property et class var autant s'en servir !

Pour ma part, je préfère écrire dans mon TBidule.Instance.Propriété...

De plus, il n'y a RIEN dans le code de TBidule que l'on doit l'utiliser comme Singleton, donc rien empêche que l'on fasse des Create !

Au passage, j'ai donc expérimenté une nouveauté pour moi, les class constructor !
Et l'Astuce pour masquer le constructeur Create en m'inspirant de la proposition de yanniel !

Voici le code de la Pattern (j'ai prévu d'en faire d'autres)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
unit SLT.Common.DesignPattern;
 
interface
 
uses System.SysUtils;
 
type
  { Forward class declarations }
  TSLTSingleton<T: class, constructor> = class;
  TSLTSingletonThreadSafe<T: class, constructor> = class;
 
  /// <summary>Erreur de base liée au Patron de Conception (Design Pattern)</summary>
  ESLTDesignPatternError = class(Exception);
 
  /// <summary>Erreur de base liée au Patron de Conception "Singleton"</summary>
  ESLTSingletonError = class(ESLTDesignPatternError)
  public
    type
      TErrorType = (setCheckInstanceAssertion);
  public
    constructor Create(ErrorType: TErrorType; ASingletonClass: TClass);
  end;
 
  /// <summary>Aide pour la création d'une classe respectant le Patron de Conception "Singleton"</summary>
  TSLTSingleton<T: class, constructor> = class(TObject)
  private
    class var
      FInstance: T;
  protected
    class function GetInstance(): T; static;
    class procedure CheckInstance(Obj: T);
  public
    // Constructeurs de Classe
    class destructor Destroy;
    /// <summary>Masquage du constructeur non virtuel Create par cette méthode de classe</summary>
    class function Create(): T;
 
    // Propriétés de Classe
    class property Instance: T read GetInstance;
  end;
 
  /// <summary>Classe aidant la création d'une classe respecant le Patron de Conception "Singleton" avec prise en compte des Threads</summary>
  TSLTSingletonThreadSafe<T: class, constructor> = class(TSLTSingleton<T>)
 
  end;
 
 
implementation
 
const
  SINGLETON_ASSERT_CHECK_INSTANCE_FMT = 'Must Call property "Instance" of "%s" and not named constructor "Create"'; // Do not localize
  SINGLETON_ERRORS: array[ESLTSingletonError.TErrorType] of string = (SINGLETON_ASSERT_CHECK_INSTANCE_FMT);
 
{ ESLTSingletonError }
 
//------------------------------------------------------------------------------
constructor ESLTSingletonError.Create(ErrorType: TErrorType; ASingletonClass: TClass);
begin
  CreateFmt(SINGLETON_ERRORS[ErrorType], [ASingletonClass.ClassName()]);
end;
 
{ TSLTSingleton<T> }
 
//------------------------------------------------------------------------------
class procedure TSLTSingleton<T>.CheckInstance(Obj: T);
begin
  if Assigned(FInstance) and Assigned(Obj) and (Obj <> FInstance) then
    raise ESLTSingletonError.Create(setCheckInstanceAssertion, Obj.ClassType()); // Pseudo-Assert Exception !
end;
 
//------------------------------------------------------------------------------
class function TSLTSingleton<T>.Create(): T;
begin
  Result := Instance;
end;
 
//------------------------------------------------------------------------------
class destructor TSLTSingleton<T>.Destroy;
begin
  FreeAndNil(FInstance);
end;
 
//------------------------------------------------------------------------------
class function TSLTSingleton<T>.GetInstance: T;
begin
  if not Assigned(FInstance) then
    FInstance := T.Create();
 
  Result := FInstance;
end;
 
end.

une Utilisation simpliste :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
type
  TBiduleSingleton : TSingletonInstance<TBidule>;
  TBiduleFauxDoublon : TSingletonInstance<TBidule>;
 
constructor TBidule.Create();
begin
  inherited Create();
 
  TBiduleSingleton.CheckInstance(Self);
  TBiduleFauxDoublon.CheckInstance(Self);
 
  if TBiduleSingleton.Create() = TBiduleSingleton.Instance then
    Beep();
 
  if TBiduleFauxDoublon.Instance = TBiduleSingleton.Instance then
    Beep();
end;
Comme c'est au niveau de la classe que cela gère l'instance du Singleton, il est plus difficile de le contourner en jouant juste sur plusieurs déclarations du même template
Mais rien n'empêche d'appeler le constructor Create de TBidule !

De plus, la syntaxe est pour le moment
Code : Sélectionner tout - Visualiser dans une fenêtre à part
TBiduleSingleton.Instance.Propriété
, il est possible de faire une encapsulation dans TBidule pour obtenir
Code : Sélectionner tout - Visualiser dans une fenêtre à part
TBidule.Instance.Propriété
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
type
  TBidule = class(TObject)
  private
    type
      TBiduleSingleton = TSLTSingleton<TBidule>;
  public
    // Constructeurs d'Instance
    constructor Create();
    destructor Destroy(); override;
    /// <summary>Singleton : Point d'Accès unique du TBidule</summary>
    class function GetInstance(): TBidule; static;
 
    // Propriétés de Classe
    class property Instance: TBidule read GetInstance;
  public
end;
 
//------------------------------------------------------------------------------
constructor TBidule.Create;
begin
  TBiduleSingleton.CheckInstance(Self);
 
  // Les Initialisations de TBidule
end;
 
//------------------------------------------------------------------------------
destructor TBidule.Destroy;
begin
  // Les Libérations de TBidule
end;
 
//------------------------------------------------------------------------------
class function TBidule.GetInstance: TBidule;
begin
  Result := TBiduleSingleton.Instance;
end;
Voilà, cela ne sert pas à grand chose mais cela m'a fait découvrir des éléments inconnus
Je trouve le class constructor et class destructor plus élégant des sections initialization et finalization