Safety Design with a Static Instance

Problem/Question/Abstract:

The Singelton Pattern is widely used, on the other side OP lacks of statics, means one instance for all classes. No problem with the following design which acts like a time-server.

Answer:

Sometimes operations are performed on a class itself, rather than on instances of a class (that is, objects). This happens, for example, when you call a constructor method using a class reference.

TTimeKeeper = class;
TTimeKeeperClass = class of TTimeKeeper;

You can always refer to a specific class using its name, but at times it is necessary to declare variables or parameters that take classes as values, and in these situations you need class-reference types.
In our case we need a class-method and a global function too to get the one and only instance:

class function Instance: TTimeKeeper;

function TimeKeeper: TTimeKeeper; //global function

When this function is called, a safety instance is returned:

function TimeKeeper: TTimeKeeper;
begin
Result := TTimeKeeper.Instance;
end;

A class method is a method (other than a constructor) that operates on classes instead of objects. The definition of a class method must begin with the reserved word class. A class method can be called through a class reference or an object reference.
So the client calls the class method first:

procedure TMainDlg.NewBtnClick(Sender: TObject);
var
myTimer: TTimeKeeper;
begin
myTimer := TimeKeeper;
StatusBar.Panels[0].Text := timeToStr(myTimer.now);
end;

And the class method returns the protected and local instance:

class function TTimeKeeper.Instance: TTimeKeeper;
// Single Instance function - create when first needed
begin
Assert(Assigned(TimeKeeperClass));
if not Assigned(TimeKeeperInstance) then
TimeKeeperInstance := TimeKeeperClass.SingletonCreate;
Result := TimeKeeperInstance;
end;

unit SafetyTimeKeeper;

interface

uses
SysUtils;

type
ESingleton = class(Exception);

TInvalidateDestroy = class(TObject)
protected
class procedure SingletonError;
public
destructor Destroy; override;
end;

TTimeKeeper = class;
TTimeKeeperClass = class of TTimeKeeper;
TTimeKeeper = class(TInvalidateDestroy)
private
class procedure Shutdown;
function GetTime: TDateTime;
function GetDate: TDateTime;
function GetNow: TDateTime;
protected
// Allow descendents to set a new class for the instance:
class procedure SetTimeKeeperClass(aTimeKeeperClass: TTimeKeeperClass);
// Actual constructor and destructor that will be used:
constructor SingletonCreate; virtual;
destructor SingletonDestroy; virtual;
public
// Not for use - for obstruction only:
class procedure Create;
class procedure Free(Dummy: integer);
{$IFNDEF VER120}{$WARNINGS OFF}{$ENDIF}
// This generates warning in D3. D4 has reintroduce keyword to solve this
class procedure Destroy(Dummy: integer);
{$IFDEF VER120} reintroduce;
{$ENDIF}
// Simple interface:
class function Instance: TTimeKeeper;
property Time: TDateTime read GetTime;
property Date: TDateTime read GetDate;
property Now: TDateTime read GetNow;
end;
{$IFNDEF VER120}{$WARNINGS ON}{$ENDIF}

function TimeKeeper: TTimeKeeper;

implementation

class procedure TInvalidateDestroy.SingletonError;
// Raise an exception in case of illegal use
begin
raise ESingleton.CreateFmt('Illegal use of %s singleton instance!', [ClassName]);
end;

destructor TInvalidateDestroy.Destroy;
// Protected against use of default destructor
begin
SingletonError;
end;

{ TTimeKeeper }
var
TimeKeeperInstance: TTimeKeeper = nil;
TimeKeeperClass: TTimeKeeperClass = TTimeKeeper;

class procedure TTimeKeeper.SetTimeKeeperClass(aTimeKeeperClass: TTimeKeeperClass);
// Allow change of instance class
begin
Assert(Assigned(aTimeKeeperClass));
if Assigned(TimeKeeperInstance) then
SingletonError;
TimeKeeperClass := aTimeKeeperClass;
end;

class function TTimeKeeper.Instance: TTimeKeeper;
// Single Instance function - create when first needed
begin
Assert(Assigned(TimeKeeperClass));
if not Assigned(TimeKeeperInstance) then
TimeKeeperInstance := TimeKeeperClass.SingletonCreate;
Result := TimeKeeperInstance;
end;

class procedure TTimeKeeper.Shutdown;
// Time to close down the show
begin
if Assigned(TimeKeeperInstance) then
begin
TimeKeeperInstance.SingletonDestroy;
TimeKeeperInstance := nil;
end;
end;

constructor TTimeKeeper.SingletonCreate;
// Protected constructor
begin
inherited Create;
end;

destructor TTimeKeeper.SingletonDestroy;
// Protected destructor
begin
// We cannot call inherited Destroy; here!
// It would raise an ESingleton exception
end;

// Protected against use of default constructor

class procedure TTimeKeeper.Create;
begin
SingletonError;
end;
// Protected against use of Free

class procedure TTimeKeeper.Free(Dummy: integer);
begin
SingletonError;
end;

class procedure TTimeKeeper.Destroy(Dummy: integer);
begin
SingletonError;
end;

// Property access methods

function TTimeKeeper.GetDate: TDateTime;
begin
Result := SysUtils.Date;
end;

function TTimeKeeper.GetNow: TDateTime;
begin
Result := SysUtils.Now;
end;

function TTimeKeeper.GetTime: TDateTime;
begin
Result := SysUtils.Time;
end;

// Simplified functional interface

function TimeKeeper: TTimeKeeper;
begin
Result := TTimeKeeper.Instance;
end;

initialization
finalization
// Destroy when application closes
TTimeKeeper.Shutdown;
end.