Write a non-visible component that allows only one instance of itself at design time

Problem/Question/Abstract:

How to write a non-visible component that allows only one instance of itself at design time

Answer:

Adapted singleton class from Borland Comunity. My prototype allows for inheritance, such as:

{ ... }
type
  {TApplication}
  TApplication = class(TSingleton)
  protected
    procedure InitializeInstance; override;
    procedure FinalizeInstance; override;
  end;

  {TScreen}
  TScreen = class(TSingleton)
  protected
    procedure InitializeInstance; override;
    procedure FinalizeInstance; override;
  end;

All internal members (data/objects) will be created/ destroyed in InitializeInstance/ FinalizeInstance

{ ... }
var
  A1, A2: TApplication;
  S1, S2: TScreen;
begin
  A1 := TApplication.Create;
  A2 := TApplication.Create;
  S1 := TScreen.Create;
  S2 := TScreen.Create;
  { ... }
  {Note, my code: A1 = A2 and S1 = S2 and A1 <> S1}
  A1.Free;
  A2.Free;
  S2.Free;
  S1.Free;
end;

To optimize the code I would suggest using this approach for  creation of objects inheriting from TSingleton:

unit singleton;

interface

uses
  Classes;

type
  {you can inherit from TSingleton and create different singleton objects}
  TSingleton = class
  private
    FRef: Integer;
  protected
    procedure InitializeInstance; virtual;
    procedure FinalizeInstance; virtual;
  public
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
  end;

implementation

var
  Singletons: TStringList = nil;

procedure TSingleton.FreeInstance;
var
  Index: Integer;
  Instance: TSingleton;
begin
  Singletons.Find(ClassName, Index);
  Instance := TSingleton(Singletons.Objects[Index]);
  Dec(Instance.FRef);
  if Instance.FRef = 0 then
  begin
    Singletons.Delete(Index);
    Instance.FinalizeInstance;
    {at this point, Instance = Self. We want to call TObject.FreeInstance}
    inherited FreeInstance;
  end;
end;

procedure TSingleton.FinalizeInstance;
begin
end;

procedure TSingleton.InitializeInstance;
begin
end;

class function TSingleton.NewInstance: TObject;
var
  Index: Integer;
begin
  if Singletons = nil then
  begin
    Singletons := TStringList.Create;
    Singletons.Sorted := true;
    Singletons.Duplicates := dupError;
  end;
  if not Singletons.Find(ClassName, Index) then
  begin
    Result := inherited NewInstance;
    TSingleton(Result).FRef := 1;
    TSingleton(Result).InitializeInstance;
    Singletons.AddObject(ClassName, Result);
  end
  else
  begin
    Result := Singletons.Objects[Index];
    Inc(TSingleton(Result).FRef);
  end;
end;

procedure CleanupSingletons;
var
  i: integer;
begin
  if Singletons <> nil then
  begin
    for i := 0 to Pred(Singletons.Count) do
      if Assigned(Singletons.Objects[i]) then
        Singletons.Objects[i].Free;
    Singletons.Free;
  end;
end;

initialization

finalization
  CleanupSingletons;

end.