Singleton design pattern

Program Singletontest;

Uses form, mainfrm in 'mainfrm.pas' {form1}, singletonfrm in 'Singletonfrm.Pas' {FORM2};

{$ R * .res}

Begin Application.initialize; Application.createform (TFORM1, FORM1); Application.Run; End.Unit SingletonFrm

Interface

Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls;

type TForm2 = class (TForm) Button1: TButton; Button2: TButton; Edit1: TEdit; procedure Button1Click (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure Button2Click (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormCreate (Sender: TObject); private {Private declarations} public {public declarations} selfptr: Tform2; class function GetInstancePtr: integer; class function GetInstance: TForm2; end;

Var Form2: TFORM2;

IMPLEMENTATION

{$ R * .dfm} procedure tform2.button1click (sender: TOBJECT); begin hide;

Procedure TFORM2.FormClose (Sender: Tobject; VAR Action: Tclosection); begin action: = cafree;

Procedure TFORM2.BUTTON2CLICK (Sender: TOBJECT); begin close;

Procedure TFORM2.FORMDESTROY (Sender: TOBJECT); Begin Selfptr: = NIL; END;

Procedure TFORM2.FormCreate (Sender: TOBJECT); Begin Selfptr: = Self; End;

Class Function TFORM2.GETITINSTANCEPTR: INTEGER; Const Isave: Integer = 0; Var Pr: Pointer; P: ^ Integer; Form: TFORM2; Begin P: = @ Isave; Form: = NIL; IF (isave <> 0) THEN BEGIN Result: = isave; form: = pointer (isave); end; if not assigned (form) THEN BEGIN form: = tForm2.create (nil); p ^: = integer (form); result: = isave; end else NOT ASSIGNED (Form.selfptr) THEN BEGIN FORM: = TFORM2.CREATE (NIL); p ^: = INTEGER (form); result: = isave; end; end; class function tform2.getinstance: tForm2; recomcom: = Pointer GetInstancePtr);

End.unit mainfrm;

Interface

Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls;

type TForm1 = class (TForm) Button1: TButton; Edit1: TEdit; Button2: TButton; Button3: TButton; Edit2: TEdit; Button4: TButton; Button5: TButton; procedure Button2Click (Sender: TObject); procedure Button1Click (Sender: TObject) ; procedure Button3Click (Sender: TObject); procedure Button4Click (Sender: TObject); procedure Button5Click (Sender: TObject); private {Private declarations} public {public declarations} end;

TSingleton = class (TObject) private Fusername: string; procedure SetUsername (const Value: string); published destructor Destroy; override; public property Username: string read Fusername write SetUsername; class function GetInstancePtr (value: integer): integer; class Function GetInstance : Tsingleton; end;

Var Form1: TFORM1;

IMPLEMENTATION

Uses Singletonfrm;

{$ R * .dfm}

procedure TForm1.Button1Click (Sender: TObject); var Form2: TForm2; begin Form2: = Tform2.GetInstance; Edit1.Text: = inttostr (integer (Form2)); Form2.Show; end; procedure TForm1.Button2Click (Sender: TObject ); var FRM2: TFORM2; Begin FRM2: = TFORM2.GETINSTANCE; frm2.free;

{Tsingleton}

DESTRUCTOR TSIINGETON.DESTROY; Begin GetInstancePtr (1); inherited;

Class Function Tsingleton.GetInstance: Tsingleton; Begin Result: = POINTER (GetInstancePtr (0));

Class Function Tsingleton.GetInstancePtr (Value: Integer): Integer; const isave: integer = 0; var P: ^ integer; obj: tsingleton; begin p: = @ isave; obj: = nil; case value of 0: beginiff ISAVE <> 0) THEN Begin Result: = isave; Obj: = Pointer (isave); end; if not assigned (obj) THEN BEGIN OBJ: = Tsingleton.create; p ^: = integer (obj); result: = isave ; End end; 1: begin p ^: = 0; end; end;

Procedure tsingleton.setUsername (const value: string); begin fusername: = value;

Procedure TForm1.Button3Click (Sender: Tobject); var singleton: tsingleton; begin singleton: = tsingleton.getinstance; singleleton.username: = Edit1.Text;

Procedure TForm1.Button4Click (Sender: Tobject); VAR Singleton: Tsingleton; Begin Singleton: = Tsingleton.GetInstance; Edit2.Text: = Singleton.usename;

Procedure TForm1.Button5Click (Sender: Tobject); VAR Singleton: Tsingleton; Begin Singleton: = Tsingleton.GetInstance; Singleton.Free;

End.