Singletons vererben

[Elvis]

Zitat:

Ich habe zum Beispiel auch noch keine wirklich schicke Factory in Delphi gesehen (eine Factory für mehr als eine Klasse). Entweder die Objekte müssen sich des Patterns bewusst sein (TDerivedSingleton hat eine eigene Class Function Instance(), oder bereits der Vorfahre muss über die Nachfahren informiert sein.

Das geht sehr wohl. Ist zwar nicht wirklich hübsch, aber auch nicht häslich.
Da ich die Klassenregistrierung in der Delphi RTL extrem widerlich finde, habe ich
alzaimars IntegerDictionary genommen.(Beide wirklich seeehr praktische Klassen, btw)
Dort habe ich den Pointer auf die jeweilige Meta class (cast auf Integer) als Key abgelegt, der dazugehörige Wert ist die Instanz dieser Klasse.

Delphi-Quellcode:

type
   TSingleton = class
   protected
      constructor UglyHiddenCreate; virtual;
   public
      class function GetInstance : TSingleton;
      constructor Create; reintroduce;
   end;
   TSingletonClass = class of TSingleton;
implementation
uses
   csDictionary,
   SysUtils;

{ TSingleton }

constructor TSingleton.Create;
begin
   raise Exception.Create('bla bla...');
end;

constructor TSingleton.UglyHiddenCreate;
begin
   inherited Create();
end;

class function TSingleton.GetInstance: TSingleton;
const
   dictionary : TIntegerDictionary = nil;
var
   key : Integer;
   pointerToResult : Pointer;
begin
   if not Assigned(dictionary) then
      dictionary := TIntegerDictionary.Create();

   key := Integer(self);

   if not dictionary.Find(key, pointerToResult) then
   begin
      result := UglyHiddenCreate();
      dictionary.Add(key, result);
   end
   else
      Result := TSingleton(pointerToResult);
end;

2 TestKlassen:

Delphi-Quellcode:

uses
   uSingleton;

type
   TSingletonA = class(TSingleton)
   end;

   TSingletonB = class(TSingleton)
   end;

Der Beweis:

Delphi-Quellcode:

procedure TestIt(singletonClass : TSingletonClass);
var
   instance1,
   instance2 : TSingleton;
begin
   instance1 := singletonClass.GetInstance();
   instance2 := singletonClass.GetInstance();

   Writeln(Format('%s: instance1 = instance2 is %s',
                         [singletonClass.ClassName(),
                           BoolToStr(instance1 = instance2, True)]));
end;

begin
   TestIt(TSingletonA);
   TestIt(TSingletonB);
end.

Output

TSingletonA: instance1 = instance2 is True
TSingletonB: instance1 = instance2 is True

edit: Nachdem ich erst tommies Zitat vergass, hatte ich auch noch den TestCode mit dem StringDictionary hier abgeschickt