《GOF设计模式》—单件(Singleton)—Delphi源码示例：创建Singleton类的子类（重载Instance方法）

示例：创建Singleton类的子类（重载Instance方法）
说明：
另一个选择Singleton的子类的方法是将Instance的实现从父类中分离出来并将它放入子类。
代码：
unit uSingleton3;

interface

uses
SysUtils, Dialogs;

type
TSingleton = class
private
class var
FInstance: TSingleton;
public
constructor Create;
destructor Destroy; override;
//---
class function Instance: TSingleton;virtual;
procedure Operate;virtual;
end;
TSingletonA = class(TSingleton)
public
class function Instance: TSingleton; override;
procedure Operate; override;
end;
TSingletonB = class(TSingleton)
public
class function Instance: TSingleton; override;
procedure Operate; override;
end;

implementation

constructor TSingleton.Create;
begin
if FInstance = nil then
FInstance := Self
else
abort;
end;

destructor TSingleton.Destroy;
begin
FInstance := nil;
//---
inherited;
end;

class function TSingleton.Instance: TSingleton;
begin
if FInstance = nil then
FInstance := TSingleton.Create;
//---
Result := FInstance;
end;

procedure TSingleton.Operate;
begin
ShowMessage('Singleton');
end;

class function TSingletonA.Instance: TSingleton;
begin
if FInstance = nil then
FInstance := TSingletonA.Create;
//---
Result := FInstance;
end;

procedure TSingletonA.Operate;
begin
ShowMessage('SingletonA');
end;

class function TSingletonB.Instance: TSingleton;
begin
if FInstance = nil then
FInstance := TSingletonB.Create;
//---
Result := FInstance;
end;

procedure TSingletonB.Operate;
begin
ShowMessage('SingletonB');
end;

end.

procedure TForm1.Button5Click(Sender: TObject);
begin
TSingleton.Instance.Operate;
TSingleton.Instance.Free;
//---
TSingletonA.Instance.Operate;
TSingletonA.Instance.Free;
//---
TSingletonB.Instance.Operate;
TSingletonB.Instance.Free;
end;