Author: Tomas Rutkauskas

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:

1   { ... }
2   type
3     {TApplication}
4     TApplication = class(TSingleton)
5     protected
6       procedure InitializeInstance; override;
7       procedure FinalizeInstance; override;
8     end;
9   
10    {TScreen}
11    TScreen = class(TSingleton)
12    protected
13      procedure InitializeInstance; override;
14      procedure FinalizeInstance; override;
15    end;
16  
17  //All internal members (data/objects) will be created/ destroyed in 
18  InitializeInstance/ FinalizeInstance
19  
20  { ... }
21  var
22    A1, A2: TApplication;
23    S1, S2: TScreen;
24  begin
25    A1 := TApplication.Create;
26    A2 := TApplication.Create;
27    S1 := TScreen.Create;
28    S2 := TScreen.Create;
29    { ... }
30    {Note, my code: A1 = A2 and S1 = S2 and A1 <> S1}
31    A1.Free;
32    A2.Free;
33    S2.Free;
34    S1.Free;
35  end;
36  
37  //To optimize the code I would suggest using this approach for  creation of objects 
38  inheriting from TSingleton:
39  
40  unit singleton;
41  
42  interface
43  
44  uses
45    Classes;
46  
47  type
48    {you can inherit from TSingleton and create different singleton objects}
49    TSingleton = class
50    private
51      FRef: Integer;
52    protected
53      procedure InitializeInstance; virtual;
54      procedure FinalizeInstance; virtual;
55    public
56      class function NewInstance: TObject; override;
57      procedure FreeInstance; override;
58    end;
59  
60  implementation
61  
62  var
63    Singletons: TStringList = nil;
64  
65  procedure TSingleton.FreeInstance;
66  var
67    Index: Integer;
68    Instance: TSingleton;
69  begin
70    Singletons.Find(ClassName, Index);
71    Instance := TSingleton(Singletons.Objects[Index]);
72    Dec(Instance.FRef);
73    if Instance.FRef = 0 then
74    begin
75      Singletons.Delete(Index);
76      Instance.FinalizeInstance;
77      {at this point, Instance = Self. We want to call TObject.FreeInstance}
78      inherited FreeInstance;
79    end;
80  end;
81  
82  procedure TSingleton.FinalizeInstance;
83  begin
84  end;
85  
86  procedure TSingleton.InitializeInstance;
87  begin
88  end;
89  
90  class function TSingleton.NewInstance: TObject;
91  var
92    Index: Integer;
93  begin
94    if Singletons = nil then
95    begin
96      Singletons := TStringList.Create;
97      Singletons.Sorted := true;
98      Singletons.Duplicates := dupError;
99    end;
100   if not Singletons.Find(ClassName, Index) then
101   begin
102     Result := inherited NewInstance;
103     TSingleton(Result).FRef := 1;
104     TSingleton(Result).InitializeInstance;
105     Singletons.AddObject(ClassName, Result);
106   end
107   else
108   begin
109     Result := Singletons.Objects[Index];
110     Inc(TSingleton(Result).FRef);
111   end;
112 end;
113 
114 procedure CleanupSingletons;
115 var
116   i: integer;
117 begin
118   if Singletons <> nil then
119   begin
120     for i := 0 to Pred(Singletons.Count) do
121       if Assigned(Singletons.Objects[i]) then
122         Singletons.Objects[i].Free;
123     Singletons.Free;
124   end;
125 end;
126 
127 initialization
128 
129 finalization
130   CleanupSingletons;
131 
132 end.