Singleton Design Pattern in Delphi

Applications in Delphi

There are several examples of this sort of class in the Delphi VCL, such as TApplication, TScreen or TClipboard. The pattern is useful whenever you want a single global object in your application. Other uses might include a global exception handler, application security, or a single point of interface to another application.

Implementation Example

To implement a class of this type, override the constructor and destructor of the class to refer to a global (interface) variable of the class.

Abort the constructor if the variable is assigned, otherwise create the instance and assign the variable.

In the destructor, clear the variable if it refers to the instance being destroyed.

Note: To make the creation and destruction of the single instance automatic, include its creation in the initialization section of the unit. To destroy the instance, include its destruction in an ExitProc or in the finalization section of the unit.

The following Delphi example illustrates two singleton classes, one derived from TComponent and another derived from TObject.

 unit Singletn; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs; type TCSingleton = class(TComponent) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; TOSingleton = class(TObject) public constructor Create; destructor Destroy; override; end; var Global_CSingleton: TCSingleton; Global_OSingleton: TOSingleton; procedure Register; implementation procedure Register; begin RegisterComponents('Design Patterns', [TCSingleton]); end; //TCSingleton constructor TCSingleton.Create(AOwner: TComponent); begin if Global_CSingleton <> nil then {NB could show a message or raise a different exception here} Abort else begin inherited Create(AOwner); Global_CSingleton := Self; end; end; destructor TCSingleton.Destroy; begin if Global_CSingleton = Self then Global_CSingleton := nil; inherited Destroy; end; //TOSingleton constructor TOSingleton.Create; begin if Global_OSingleton <> nil then {NB could show a message or raise a different exception here} Abort else Global_OSingleton := Self; end; destructor TOSingleton.Destroy; begin if Global_OSingleton = Self then Global_OSingleton := nil; inherited Destroy; end; procedure FreeGlobalObjects; far; begin if Global_CSingleton <> nil then Global_CSingleton.Free; if Global_OSingleton <> nil then Global_OSingleton.Free; end; begin AddExitProc(FreeGlobalObjects); end. 

Code examples