Singleton 模式

Question

一个单例模式的实现，大伙来评评unit uSingleton;interfaceuses
  SysUtils, Contnrs, Classes, Windows, Messages;type
  TAccessType = (atGet, atFree, atFreeAll);
  // Singleton
  TSingleton = class(TInterfacedPersistent)
  private
    // Access the acture Instance
    class function AccessInstance(const AccessType: TAccessType = atGet): TSingleton;
  protected
    // acture instance
    constructor CreateInstance; virtual;
    procedure AlterConstruct; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    class function Instance(): TSingleton;
    class procedure ReleaseInstance(); 
    class procedure ReleaseAllInstance();  
  end;  // 带句柄的单例
  THandleSingleton = class(TSingleton)
  private
    FHandle: HWND;
  protected
    constructor CreateInstance; override;
    procedure WndProc(var Msg: TMessage); virtual;
  public
    destructor Destroy; override;
    class function Instance(): THandleSingleton;    property Handle: HWND read FHandle;
  end;implementationtype
  // 单例容器
  TSingletonList = class(TComponent)
  private
    FList: TObjectList;
    FStrList: TStringList;
    function GetItems(const AClass: TClass): TSingleton;
    function GetItemsByIndex(const AIndex: Integer): TSingleton;
  protected  
    procedure Remove(AClass: String); overload;
    procedure Remove(AIndex: Integer); overload;
    procedure Clear();
    property ItemsByIndex[const AIndex: Integer]: TSingleton read GetItemsByIndex;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add(ASingleton: TSingleton): Integer;    procedure Remove(ASingleton: TSingleton); overload;
    procedure Remove(AClass: TClass); overload;
    property Items[const AClass: TClass]: TSingleton read GetItems;
  end;
{ TSingleton }class function TSingleton.AccessInstance(const AccessType: TAccessType = atGet): TSingleton;
  {$J+}
  const FInstance: TSingletonList = nil; // 可写常量，相当于静态变量
  {$J-}
begin
  if not Assigned(FInstance) then
    FInstance := TSingletonList.Create(nil);  Result := nil;
  case AccessType of
    atGet:
      begin
        Result := FInstance.Items[Self];
        if not Assigned(Result) then
        begin
          Result := Self.CreateInstance();
          FInstance.Add(Result);
          Result.AlterConstruct;
        end;
      end;
    atFree:
      begin
        FInstance.Remove(Self);
      end;
    atFreeAll:
      begin
        FInstance.Free;
        FInstance := nil;
      end;
  end;
end;procedure TSingleton.AlterConstruct;
begin
//
end;constructor TSingleton.Create;
begin
  raise Exception.Create('TSingleton can only access through Instance function!');
end;constructor TSingleton.CreateInstance;
begin
  inherited Create();
end;destructor TSingleton.Destroy;
begin
  
  inherited;
end;class function TSingleton.Instance: TSingleton;
begin
  Result := AccessInstance;
end;class procedure TSingleton.ReleaseAllInstance;
begin
  AccessInstance(atFreeAll);
end;class procedure TSingleton.ReleaseInstance;
begin
  AccessInstance(atFree);
end;{ TSingletonList }function TSingletonList.Add(ASingleton: TSingleton): Integer;
begin
  Result := FStrList.AddObject(ASingleton.ClassName, ASingleton);
  FList.Add(ASingleton);
end;procedure TSingletonList.Clear;
begin
  FList.Clear;
//  while FList.Count > 0 do
//    FList.Delete(FList.Count - 1);
end;constructor TSingletonList.Create(AOwner: TComponent);
begin
  inherited;
  FStrList := TStringList.Create;
  FStrList.Sorted := True;
  FStrList.Duplicates := dupIgnore;  FList := TObjectList.Create;
end;destructor TSingletonList.Destroy;
begin
  Clear;
  FStrList.Free;
  FList.Free;
  inherited;
end;function TSingletonList.GetItems(const AClass: TClass): TSingleton;
var
  I: Integer;
begin
  Result := nil;
  if Assigned(AClass) then
  begin
    I := FStrList.IndexOf(AClass.ClassName);
    if I <> -1 then
      Result := ItemsByIndex[I];
  end;
end;procedure TSingletonList.Remove(ASingleton: TSingleton);
begin
  if Assigned(ASingleton) then
    Remove( ASingleton.ClassName );
end;function TSingletonList.GetItemsByIndex(const AIndex: Integer): TSingleton;
begin
  Result := nil;  
  if (AIndex >= 0) and (AIndex < FStrList.Count) then
    Result := TSingleton(FStrList.Objects[AIndex]);
end;procedure TSingletonList.Remove(AClass: TClass);
begin
  if Assigned(AClass) then
    Remove( AClass.ClassName );
end;procedure TSingletonList.Remove(AClass: String);
begin
  Remove( FStrList.IndexOf(AClass) );
end;procedure TSingletonList.Remove(AIndex: Integer);
var
  FObj: TSingleton;
begin
  if (AIndex >= 0) and (AIndex < FStrList.Count) then
  begin
    FObj := ItemsByIndex[AIndex];
    FStrList.Delete(AIndex);
    if Assigned(FObj) then
      FList.Remove(FObj);
  end;
end;{ THandleSingleton }constructor THandleSingleton.CreateInstance;
begin
  inherited;
            
  FHandle := AllocateHWnd(WndProc);
end;destructor THandleSingleton.Destroy;
begin     
  DeallocateHWnd(FHandle);  inherited;
end;class function THandleSingleton.Instance: THandleSingleton;
begin
  Result := inherited Instance as THandleSingleton;
end;procedure THandleSingleton.WndProc(var Msg: TMessage);     
begin
  with Msg do
    Result := DefWindowProc(FHandle, Msg, wParam, lParam);
end;initializationfinalization
  TSingleton.ReleaseAllInstance;end.

Answer 1

http://delphi.about.com/od/oopindelphi/a/aa010201a.htm

Answer 2

汗一个楼上的，我才想问呢，没想比我还早^_^个人感觉还是有点复杂，特别作为Sort在一开始就控制，如果一次性有多实例加入的话，不支持BeginUpdate/EndUpdate，那么可能会损失相当的效率。

Answer 3

Singleton模式已经是非常成型的了一些大型的项目中 是一个必须的设计模式你看看稍微大一点的项目看看别人设计的试试