设计模式之singleton

核心提示： PRogram singletonTest;uses Forms, mainfrm in 'mainfrm.pas' {Form1}, singletonfrm in 'singletonfrm.pas' {Form2};{$R *.res}begin application.

 

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.