设计模式之singleton

nice凌开

nice凌开

2016-02-19 18:24

今天图老师小编要跟大家分享设计模式之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;

(本文来源于图老师网站,更多请访问http://m.tulaoshi.com/bianchengyuyan/)

  implementation

  {$R *.dfm}
  procedure TForm2.Button1Click(Sender: TObject);
  begin
    hide;
  end;

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

(本文来源于图老师网站,更多请访问http://m.tulaoshi.com/bianchengyuyan/)

  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 (isave0) 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 (isave0) 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.

展开更多 50%)
分享

猜你喜欢

设计模式之singleton

编程语言 网络编程
设计模式之singleton

C++设计模式之Singleton

编程语言 网络编程
C++设计模式之Singleton

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

Singleton设计模式的C#实现

编程语言 网络编程
Singleton设计模式的C#实现

Delphi实现Singleton模式

编程语言 网络编程
Delphi实现Singleton模式

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

五种单件模式之Singleton的实现方法详解

编程语言 网络编程
五种单件模式之Singleton的实现方法详解

设计模式之State

编程语言 网络编程
设计模式之State

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

WPS文字制作公文“三板斧”

WPS文字制作公文“三板斧”

Win7/Win8/Win8.1系统升级到win10正式版有哪些区别

Win7/Win8/Win8.1系统升级到win10正式版有哪些区别
下拉加载更多内容 ↓