singleton 模式是最有用的模式之一。大家知道我们都在使用它。类就是一个例子，Tapplication是另一个。这里我尝试解释什么是singleton，并举出实现singleton的一个有用的例子。
概述：
Singleton设计模式是Object-Class关系的一个变形。此变形是指类只是为所有的应用程序创建一个对象，并且任何时候在收到本类对象的请求时都将返回此对象。注意Tcomponent不算是singleton，因为它的对象的生存期由一个所有者管理，而且Tcomponent只能有一个所有者。两个所有者不能共有一个对象，所以Tcomponent不是singleton。
实现singleton：
1. 增加一个GetInstance函数，用来返回singleton的实例。
2. 改变Create函数以返回singleton实例。我使用第二种方法。
为了使对象成为singleton，需要重载Tobject类的部分函数。class Function NewInstance: TObject;
此函数为的对象分配内存。每次客户调用构造函数时都要调用它。
本函数只是在对象第一次建立时分配内存，并用以下的调用归还内存。本函数释放分配给对象的内存。每次调用析构函数时都要调用它。
通常singleton对象在单元结束时会销毁，所以重载本函数令其清空。
例子：
本例是我在某应用程序中使用的两个类，它们是：
Tsingleton - 实现singleton模式派生类singleton的类。
TinterfacedSingleton - 与Tsingleton相同，唯独能实现Iunknown接口（如果另外有对它们的引用，本类的对象就会在结束时或之后释放）。
注意：singleton的思路不需要从Tsingleton基类继承。代码只是一个例子，实现部分并不是一种模式，模式就是思路本身。代码：unit uSingleton;interfaceUses
SysUtils;Type
TSingleton = class(TObject)
Private
Procedure Dispose;
protected
Procedure Init; Virtual;
Procedure BeforeDestroy; Virtual;
Public
class Function NewInstance: TObject; Override;
Procedure FreeInstance; Override;
End; TInterfacedSingleton = class(TInterfacedObject, IUnknown)
Private
Procedure Dispose;
protected
Procedure Init; Virtual;
Public
class Function NewInstance: TObject; Override;
Procedure FreeInstance; Override;
Function _AddRef: Integer; stdcall;
Function _Release: Integer; stdcall;
End;
implementationVar
SingletonHash: TStringList;{ General}Procedure ClearSingletons;
Var
I: Integer;
Begin
// 为所有的singleton对象调用BeforeDestroy。
For I := 0 to SingletonHash.Count - 1 do
Begin
If SingletonHash.Objects[I] Is TSingleton then
Begin
TSingleton(SingletonHash.Objects[I]).BeforeDestroy;
End
End; // 释放所有的singleton和InterfacedSingleton对象。
For I := 0 to SingletonHash.Count - 1 do
Begin
If SingletonHash.Objects[I] Is TSingleton then
Begin
TSingleton(SingletonHash.Objects[I]).Dispose;
End
Else TInterfacedSingleton(SingletonHash.Objects[I])._Release;
End;
End;{ TSingleton }
Procedure TSingleton.BeforeDestroy;
BeginEnd;Procedure TSingleton.Dispose;
Begin
Inherited FreeInstance;
End;Procedure TSingleton.FreeInstance;
Begin
//
End;
Procedure TSingleton.Init;
BeginEnd;class function TSingleton.NewInstance: TObject;
Var
Singleton: TSingleton;
Begin
If SingletonHash = Nil then
SingletonHash := TStringList.Create;
If SingletonHash.IndexOf(Self.ClassName) = -1 then
Begin
Singleton := TSingleton(Inherited NewInstance);
Try
Singleton.Init;
SingletonHash.AddObject(Self.ClassName, singleton);
Except
Singleton.Dispose;
Raise;
End;
End;
Result := SingletonHash.Objects[SingletonHash.IndexOf(Self.ClassName)] as TSingleton;
End;{ TInterfacedSingleton }procedure TInterfacedSingleton.Dispose;
Begin
Inherited FreeInstance;
End;procedure TInterfacedSingleton.FreeInstance;
Begin
//
End;procedure TInterfacedSingleton.Init;
BeginEnd;class function TInterfacedSingleton.NewInstance: TObject;
Var
Singleton: TInterfacedSingleton;
Begin
If SingletonHash = Nil then
SingletonHash := TStringList.Create;
If SingletonHash.IndexOf(Self.ClassName) = -1 then
Begin
Singleton := TInterfacedSingleton(Inherited NewInstance);
Try
Singleton.Init;
SingletonHash.AddObject(Self.ClassName, singleton);
Singleton._AddRef;
Except
Singleton.Dispose;
Raise;
End;
End;
Result := SingletonHash.Objects[SingletonHash.IndexOf(Self.ClassName)] as TInterfacedSingleton;
End;function TInterfacedSingleton._AddRef: Integer;
Begin
Result := Inherited _AddRef;
End;function TInterfacedSingleton._Release: Integer;
Begin
Result := Inherited _Release;
End;Initialization
SingletonHash := Nil;Finalization
If SingletonHash <> Nil then
ClearSingletons;
SingletonHash.Free;End.
投稿人：CoDelphi.com 投稿日期：2001-5-22 9:30:00
Singleton模式
起源
Delphi的Decorator模式是在Decorator的基础上进行了扩展。更多Decorator模式的资料
请参阅 《设计模式84页》
目的
保证一个类仅有一个实例，并提供一个访问它的全局访问点，一个相对简单的应用型设
计模式
动机
此模式最重要的是保证大量类正确的访问单个实例。尽管一台个系统可能有多台打印机
，但系统只允许有且只有一个打印缓存。同样比如：一个系统只有一个文件系统、一个
窗体管理系统。对于Delphi的VCL来说：大家天天接触的Tapplication，Tscreen，Tcli
pboard都是。此模式更好的是使你可以在任何时候为你的应用程序提供一个全局对象。
其它的用途：可以、提供一些全局的异常句柄，安全控制，为跨进程提供单一的访问点
。
怎样保持一个类只有一个实例并且建立好的访问性能？一个全局变量保证了实例的可访
问性，但还没有保证多个实例的同时存大的可能。
一个好的解决方案：建立类自身来负责保持自身一个实例的机制。类的第一个实例能保
存不会再有类的实例被创建（在创建类的新实例时请求被中段）。并提供一个访问类的
方法。这就是我们的singleton模式，典型的应用是服务型的的类。
应用
假设有一个用于显示时间进度低级服务类Tprogressor。类包括两个典型的方法：Start
Progress, EndProgress, Abort 和一引起典型的属性如：Progress, Aborted其它。
下面代码是Tprogressor类的接口部份
type
TProgressor = class (TObject)
private
FProgress: Integer;
protected
procedure SetProgress(Value: Integer);
public
? procedure StartProgress;
? property Progress: Integer read FProgress write SetProgress;
end;
下面的代码是应用了singleton模式后的类的的接口部份。
type
TProgressor = class (TObject)
private
FProgress: Integer;
protected
constructor CreateInstance;
class function AccessInstance(Request: Integer): TProgressor;
procedure SetProgress(Value: Integer);
public
constructor Create;
destructor Destroy; override;
class function Instance: TProgressor;
class procedure ReleaseInstance;
? procedure StartProgress;
? property Progress: Integer read FProgress write SetProgress;
end;
类接口部份的介绍：
· 方法class function Instance用于访问类的单件的实例。此方法一般在第一时
间访问，类的实例被创建。
· 类构造器被重载，如果你尝试着不通过instance方法来构建一个新的实例将会
抛出一个异常。
· 可通过调用ReleaseInstance来清除单件类存在的实例。一般在你要清除部件时
调节器用些方法。在Delphi 1 exit过程中调用，在Delphi 2/3/4/5/6中在单元finaliz
ation中调用。不要访问TProgressor.Instance.Free来清除实例，
现在让我们来看看singleton模式实现。
constructor TProgressor.Create;
begin
inherited Create;
raise Exception.CreateFmt('Access class %s through Instance only',
[ClassName]);
end;
constructor TProgressor.CreateInstance;
begin
inherited Create;
end;
destructor TProgressor.Destroy;
begin
if AccessInstance(0) = Self then AccessInstance(2);
inherited Destroy;
end;
class function TProgressor.AccessInstance(Request: Integer): TProgressor;
const FInstance: TProgressor = nil;
begin
case Request of
0 : ;
1 : if not Assigned(FInstance) then FInstance := CreateInstance;
2 : FInstance := nil;
else
raise Exception.CreateFmt('Illegal request %d in AccessInstance',
[Request]);
end;
Result := FInstance;
end;
class function TProgressor.Instance: TProgressor;
begin
Result := AccessInstance(1);
end;
class procedure TProgressor.ReleaseInstance;
begin
AccessInstance(0).Free;
end
概述：
Singleton设计模式是Object-Class关系的一个变形。此变形是指类只是为所有的应用程序创建一个对象，并且任何时候在收到本类对象的请求时都将返回此对象。注意Tcomponent不算是singleton，因为它的对象的生存期由一个所有者管理，而且Tcomponent只能有一个所有者。两个所有者不能共有一个对象，所以Tcomponent不是singleton。
实现singleton：
1. 增加一个GetInstance函数，用来返回singleton的实例。
2. 改变Create函数以返回singleton实例。我使用第二种方法。
为了使对象成为singleton，需要重载Tobject类的部分函数。class Function NewInstance: TObject;
此函数为的对象分配内存。每次客户调用构造函数时都要调用它。
本函数只是在对象第一次建立时分配内存，并用以下的调用归还内存。本函数释放分配给对象的内存。每次调用析构函数时都要调用它。
通常singleton对象在单元结束时会销毁，所以重载本函数令其清空。
例子：
本例是我在某应用程序中使用的两个类，它们是：
Tsingleton - 实现singleton模式派生类singleton的类。
TinterfacedSingleton - 与Tsingleton相同，唯独能实现Iunknown接口（如果另外有对它们的引用，本类的对象就会在结束时或之后释放）。
注意：singleton的思路不需要从Tsingleton基类继承。代码只是一个例子，实现部分并不是一种模式，模式就是思路本身。代码：unit uSingleton;interfaceUses
SysUtils;Type
TSingleton = class(TObject)
Private
Procedure Dispose;
protected
Procedure Init; Virtual;
Procedure BeforeDestroy; Virtual;
Public
class Function NewInstance: TObject; Override;
Procedure FreeInstance; Override;
End; TInterfacedSingleton = class(TInterfacedObject, IUnknown)
Private
Procedure Dispose;
protected
Procedure Init; Virtual;
Public
class Function NewInstance: TObject; Override;
Procedure FreeInstance; Override;
Function _AddRef: Integer; stdcall;
Function _Release: Integer; stdcall;
End;
implementationVar
SingletonHash: TStringList;{ General}Procedure ClearSingletons;
Var
I: Integer;
Begin
// 为所有的singleton对象调用BeforeDestroy。
For I := 0 to SingletonHash.Count - 1 do
Begin
If SingletonHash.Objects[I] Is TSingleton then
Begin
TSingleton(SingletonHash.Objects[I]).BeforeDestroy;
End
End; // 释放所有的singleton和InterfacedSingleton对象。
For I := 0 to SingletonHash.Count - 1 do
Begin
If SingletonHash.Objects[I] Is TSingleton then
Begin
TSingleton(SingletonHash.Objects[I]).Dispose;
End
Else TInterfacedSingleton(SingletonHash.Objects[I])._Release;
End;
End;{ TSingleton }
Procedure TSingleton.BeforeDestroy;
BeginEnd;Procedure TSingleton.Dispose;
Begin
Inherited FreeInstance;
End;Procedure TSingleton.FreeInstance;
Begin
//
End;
Procedure TSingleton.Init;
BeginEnd;class function TSingleton.NewInstance: TObject;
Var
Singleton: TSingleton;
Begin
If SingletonHash = Nil then
SingletonHash := TStringList.Create;
If SingletonHash.IndexOf(Self.ClassName) = -1 then
Begin
Singleton := TSingleton(Inherited NewInstance);
Try
Singleton.Init;
SingletonHash.AddObject(Self.ClassName, singleton);
Except
Singleton.Dispose;
Raise;
End;
End;
Result := SingletonHash.Objects[SingletonHash.IndexOf(Self.ClassName)] as TSingleton;
End;{ TInterfacedSingleton }procedure TInterfacedSingleton.Dispose;
Begin
Inherited FreeInstance;
End;procedure TInterfacedSingleton.FreeInstance;
Begin
//
End;procedure TInterfacedSingleton.Init;
BeginEnd;class function TInterfacedSingleton.NewInstance: TObject;
Var
Singleton: TInterfacedSingleton;
Begin
If SingletonHash = Nil then
SingletonHash := TStringList.Create;
If SingletonHash.IndexOf(Self.ClassName) = -1 then
Begin
Singleton := TInterfacedSingleton(Inherited NewInstance);
Try
Singleton.Init;
SingletonHash.AddObject(Self.ClassName, singleton);
Singleton._AddRef;
Except
Singleton.Dispose;
Raise;
End;
End;
Result := SingletonHash.Objects[SingletonHash.IndexOf(Self.ClassName)] as TInterfacedSingleton;
End;function TInterfacedSingleton._AddRef: Integer;
Begin
Result := Inherited _AddRef;
End;function TInterfacedSingleton._Release: Integer;
Begin
Result := Inherited _Release;
End;Initialization
SingletonHash := Nil;Finalization
If SingletonHash <> Nil then
ClearSingletons;
SingletonHash.Free;End.
投稿人：CoDelphi.com 投稿日期：2001-5-22 9:30:00
Singleton模式
起源
Delphi的Decorator模式是在Decorator的基础上进行了扩展。更多Decorator模式的资料
请参阅 《设计模式84页》
目的
保证一个类仅有一个实例，并提供一个访问它的全局访问点，一个相对简单的应用型设
计模式
动机
此模式最重要的是保证大量类正确的访问单个实例。尽管一台个系统可能有多台打印机
，但系统只允许有且只有一个打印缓存。同样比如：一个系统只有一个文件系统、一个
窗体管理系统。对于Delphi的VCL来说：大家天天接触的Tapplication，Tscreen，Tcli
pboard都是。此模式更好的是使你可以在任何时候为你的应用程序提供一个全局对象。
其它的用途：可以、提供一些全局的异常句柄，安全控制，为跨进程提供单一的访问点
。
怎样保持一个类只有一个实例并且建立好的访问性能？一个全局变量保证了实例的可访
问性，但还没有保证多个实例的同时存大的可能。
一个好的解决方案：建立类自身来负责保持自身一个实例的机制。类的第一个实例能保
存不会再有类的实例被创建（在创建类的新实例时请求被中段）。并提供一个访问类的
方法。这就是我们的singleton模式，典型的应用是服务型的的类。
应用
假设有一个用于显示时间进度低级服务类Tprogressor。类包括两个典型的方法：Start
Progress, EndProgress, Abort 和一引起典型的属性如：Progress, Aborted其它。
下面代码是Tprogressor类的接口部份
type
TProgressor = class (TObject)
private
FProgress: Integer;
protected
procedure SetProgress(Value: Integer);
public
? procedure StartProgress;
? property Progress: Integer read FProgress write SetProgress;
end;
下面的代码是应用了singleton模式后的类的的接口部份。
type
TProgressor = class (TObject)
private
FProgress: Integer;
protected
constructor CreateInstance;
class function AccessInstance(Request: Integer): TProgressor;
procedure SetProgress(Value: Integer);
public
constructor Create;
destructor Destroy; override;
class function Instance: TProgressor;
class procedure ReleaseInstance;
? procedure StartProgress;
? property Progress: Integer read FProgress write SetProgress;
end;
类接口部份的介绍：
· 方法class function Instance用于访问类的单件的实例。此方法一般在第一时
间访问，类的实例被创建。
· 类构造器被重载，如果你尝试着不通过instance方法来构建一个新的实例将会
抛出一个异常。
· 可通过调用ReleaseInstance来清除单件类存在的实例。一般在你要清除部件时
调节器用些方法。在Delphi 1 exit过程中调用，在Delphi 2/3/4/5/6中在单元finaliz
ation中调用。不要访问TProgressor.Instance.Free来清除实例，
现在让我们来看看singleton模式实现。
constructor TProgressor.Create;
begin
inherited Create;
raise Exception.CreateFmt('Access class %s through Instance only',
[ClassName]);
end;
constructor TProgressor.CreateInstance;
begin
inherited Create;
end;
destructor TProgressor.Destroy;
begin
if AccessInstance(0) = Self then AccessInstance(2);
inherited Destroy;
end;
class function TProgressor.AccessInstance(Request: Integer): TProgressor;
const FInstance: TProgressor = nil;
begin
case Request of
0 : ;
1 : if not Assigned(FInstance) then FInstance := CreateInstance;
2 : FInstance := nil;
else
raise Exception.CreateFmt('Illegal request %d in AccessInstance',
[Request]);
end;
Result := FInstance;
end;
class function TProgressor.Instance: TProgressor;
begin
Result := AccessInstance(1);
end;
class procedure TProgressor.ReleaseInstance;
begin
AccessInstance(0).Free;
end
解决方案 »
免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货