Delphi 单例模式

单例模式简单示意, delphiXE下测试通过

unit Singleton;
(*
  单例模式适用于辅助类, 一般伴随于单元的生命周期
*)
interface
uses SysUtils;

type
  TSingleton = class
  public
    class function NewInstance : TObject; override;
    class function GetInstance : TSingleton;
    destructor Destroy; override;
    procedure FreeInstance; override;

    function Address : integer;
  end;

implementation
var
  FSingleton : TSingleton = nil;
  FCanFree : Boolean;

{ TSingleton }
function TSingleton.Address: integer;
begin
  Result := Integer(Self);
end;

destructor TSingleton.Destroy;
begin
  inherited;
end;

procedure TSingleton.FreeInstance;
begin
  if not FCanFree then Exit;
  inherited FreeInstance;
  FSingleton := nil;
end;

class function TSingleton.GetInstance: TSingleton;
begin
  if not Assigned(FSingleton) then
  begin
    FSingleton := TSingleton.Create;
  end;
  Result := FSingleton;
end;

class function TSingleton.NewInstance: TObject;
begin
  if not Assigned(FSingleton) then
  begin
    FSingleton := TSingleton(inherited NewInstance);
  end;
  Result := FSingleton;
end;

initialization
  FSingleton := TSingleton.Create;

finalization
  FCanFree := True;
  if Assigned(FSingleton) then
  begin
    FSingleton.Free;
    FSingleton := nil;
  end;

end.

unit Unit15;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Singleton, StdCtrls;

type
  TForm15 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form15: TForm15;

implementation

{$R *.dfm}

procedure TForm15.btn1Click(Sender: TObject);
var
  vTest, vTest2 : TSingleton;
begin
  vTest := TSingleton.Create;
  ShowMessage(IntToStr(vTest.Address));

  vTest2 := TSingleton.Create;
  ShowMessage(IntToStr(vTest2.Address));

//  vTest.free;
  FreeAndNil(vTest);
  vTest2.free;
end;

end.