singletonunit2.pas

来自「设计模式的源代码 Singleton模式」· PAS 代码 · 共 66 行

unit SingletonUnit2;


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;


end.