delphi singleton

Unit the Singleton;
 (* 
  singleton suitable auxiliary class, generally associated to the cell life cycle 
*) 
interface 
uses the SysUtils; 

type 
  TSingleton = class 
  public 
    class  function NewInstance,: TObject; the override ;
     class  function the GetInstance: TSingleton;
     destructor  the Destroy ; the override ;
     Procedure FreeInstance; the override ; 

    function the 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;

Guess you like

Origin www.cnblogs.com/tobetterlife/p/12169545.html