Mega Code Archive
Safety Design with a Static Instance
<![CDATA[
Title: Safety Design with a Static Instance
Question: 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.
]]>