Реализация паттерна "Singleton" в Delphi

Давно интересовала тема реализации шаблона дизайна "Singleton" в Delphi, которая бы мне просто позволила бы мне получить соответствующее поведение путем простого наследования от некоторого базового класса. В результате нескольких различных вариантов реализаций остановился на таком:

type
  // Базовый класс для объектов, реализующих паттерн 
  // "Singleton". Для получения доступа к экземпляру
  // необходимо вызвать GetInstance. Если экземпляр 
  // еще не существует, то он будет создан. Иначе -  
  // возвращена ссылка на ранее созданный экземпляр.
  // Уничтожить экземпляр можно вручную, вызвав Free, 
  // иначе он будет уничтожен автоматически перед 
  // завершением приложения
  TSingleton = class(TObject)
  private
    class procedure RegisterInstance(Instance: 
      TSingletone);
    procedure UnRegisterInstance;
    class function FindInstance: TSingletone;
  protected
    // Инициализацию производить только в этом 
    // конструкторе, а не в GetInstance.
    // Не рекомендуется выносить этот конструктор 
    // из секции protected
    constructor Create; virtual;
  public
    class function NewInstance: TObject; override;
    procedure BeforeDestruction; override;
    // Точка доступа к экземпляру
    constructor GetInstance;
  end;
...

implementation

uses Contnrs;

var
  SingletonList: TObjectList;

{ TSingleton }

procedure TSingleton.BeforeDestruction;
begin
  UnregisterInstance;
  inherited BeforeDestruction;
end;

constructor TSingleton.Create;
begin
  inherited Create;
end;

class function TSingleton.FindInstance: 
  TSingletone;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to SingletonList.Count - 1 do
    if SingletonList[i].ClassType = Self 
    then begin
      Result := TSingleton(SingletonList[i]);
      Break;
    end;
end;

constructor TSingleton.GetInstance;
begin
  inherited Create;
end;

class function TSingleton.NewInstance: TObject;
begin
  Result := FindInstance;
  if Result = nil then begin
    Result := inherited NewInstance;
    TSingleton(Result).Create;
    RegisterInstance(TSingleton(Result));
  end;
end;

class procedure TSingleton.RegisterInstance(Instance: 
  TSingleton);
begin
  SingletonList.Add(Instance);
end;

procedure TSingletone.UnRegisterInstance;
begin
  SingletonList.Extract(Self);
end;

initialization
  SingletonList := TObjectList.Create(True);

finalization
  SingletonList.Free;