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