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.

uses  Singleton;

procedure TForm1.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;