Delphi设计模式之单例模式(Singleton Pattern)

 Singleton Pattern模式的设计意图是：保证一个类仅有一个实例，并提供一个访问他的全局访问点。 
有人已经实现了这个模式，详见代码如下： 

interface
uses classes,SysUtils;

type
  TSingletonList = class(TList);

  TSingletonl = class
  public
    constructor Create;virtual;
    destructor Destroy; override;
  protected
    function Lookup(PSingleton: TSingletonl): boolean;
  end;

  TChildSingletonl = class(TSingletonl);

var
  Glob_Singletonlist: TSingletonList; //使用整体变量

implementation

constructor TSingletonl.Create;
begin
  if Lookup(self) then
    Abort
  else
    Glob_Singletonlist.Add(self);
end;

destructor TSingletonl.Destroy;
begin
  if Lookup(self) then
  begin
    Glob_Singletonlist.Remove(self);
    inherited Destroy;
  end;
end;

function TSingletonl.Lookup(PSingleton: TSingletonl): boolean;
var
  i: word;
  plSingleton: TSingletonl;
begin
  result := false;
  if (Glob_Singletonlist = nil) or (Glob_Singletonlist.Count = 0) then
  begin
    Glob_Singletonlist := TSingletonList.Create;
    result := false;
    Exit;
  end;
  for i := 0 to Glob_Singletonlist.Count - 1 do
  begin
    plSingleton := Glob_Singletonlist.Get(i);
    if (plSingleton.ClassName = PSingleton.ClassName) then
      result := true;
  end;
end;

他的这种方法是建立一个全局列表，通过查看全局列表的方式来实现singleton模式，这种方法除了没有广泛性的问题外，就是他的子类无法实现Singleton模式。所以此方法具有一定的局限性。另外一种的方法的实现： 

unit Unit4;

interface
uses
  SysUtils, Classes;

type
  TDSingleton = class(TObject)
  private
    FCount: integer;
  protected
    constructor CreateInstance;
    class function AccessInstance(Request: integer): TDSingleton;
  public
    constructor Create;
    destructor Destroy; override;
    class function Instance: TDSingleton;
    class procedure ReleaseInstance;
  end;

implementation

{$J+}
{ TDSingleton }

class function TDSingleton.AccessInstance(Request: integer): TDSingleton;
const
  FInstance: TDSingleton = nil;
begin
  case Request of
    0: ;
    1:
      begin
        if not Assigned(FInstance) then
          FInstance := CreateInstance;
      end;
    2: FInstance := nil;
    else
      raise Exception.CreateFmt('Illegal request %d in AccessInstance!', [Request]);
  end;
  result := FInstance;
end;

constructor TDSingleton.Create;
begin
  raise Exception.CreateFmt('Access class %s only through Instance!', [ClassName]);
end;

constructor TDSingleton.CreateInstance;
begin
  inherited Create;
end;

destructor TDSingleton.Destroy;
begin
  if AccessInstance(0) = self then AccessInstance(2);
  inherited Destroy;
end;

class function TDSingleton.Instance: TDSingleton;
begin
  result := AccessInstance(1);
end;

class procedure TDSingleton.ReleaseInstance;
begin
  AccessInstance(0).Free;
end;

End.

这里使用了指示符{$J+} 
$J在Delphi中的解释是： 
The $J directive controls whether typed constants can be modified or not. In the {$J+} state, typed constants can be modified, and are in essence initialized variables. In the {$J-} state, typed constants are truly constant, and any attempt to modify a typed constant causes the compiler to report an error. 
Writeable consts refers to the use of a typed const as a variable modifiable at runtime. 
【翻译】$J指示符控制常量类型是否能够被修改。在{$J+}状态，类型常量可以被修改，并且本质上是初始化为变量。在{$J-}状态，类型常量是真实的常量，并且任何试图修改一个类型常量都会引起编译器报告错误。可写常量参考运行时类型常量当作变量可修改的。 
在刘艺《Delphi设计模式》这本书中，也引用了这两个例子。并分别做了阐述，这两个例子是从网络上找到。并做了相应的改写。 当总是感觉Delphi使用此模式有些蹩脚，不像C++那么的舒畅。这是一个好的想法，但至少在Delphi中不是那么的实用。在delphi中，完全可以使用Initialization初始化一个变量，配合Finalization来释放他。