设计模式之singleton

program singletonTest;

uses
Forms,
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;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
selfptr:=nil;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
selfptr:=self;
end;

class function TForm2.GetInstancePtr: 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 if not assigned(Form.selfptr) then
begin
Form:=Tform2.Create(nil);
p^:=integer(Form);
result:=isave;
end;
end;

class function TForm2.GetInstance: TForm2;
begin
result:=pointer(GetInstancePtr);
end;

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;
end;

{ TSingleton }

destructor TSingleton.Destroy;
begin
GetInstancePtr(1);
inherited;
end;

class function TSingleton.GetInstance: Tsingleton;
begin
result:=pointer(GetInstancePtr(0));
end;

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:
begin
if (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;
end;

procedure TSingleton.SetUsername(const Value: string);
begin
Fusername := Value;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
singleton:Tsingleton;
begin
singleton:=Tsingleton.GetInstance;
singleton.Username:=Edit1.Text;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
singleton:Tsingleton;
begin
singleton:=Tsingleton.GetInstance;
Edit2.Text:=singleton.Username;

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!