|
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;
end;
procedure TForm1.Button5Click(Sender: TObject);
var
singleton:Tsingleton;
begin
singleton:=Tsingleton.GetInstance;
singleton.Free;
end;
end.
没有相关教程
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
