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;
delphi singleton
Guess you like
Origin www.cnblogs.com/tobetterlife/p/12169545.html
Recommended
Ranking