Singleton in Delphi
Why read if you can watch?
Watch Singleton's video tutorialApplications 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.
