作者：未知 来源：月光软件站 加入时间：2005-6-5　月光软件站

{*
单元说明    ：  用 ModelMaker 生成 单例程窗体模式。
作者        ：   
笔名        ：  易  一    英文名：yeeyee
E-Mail      ：  [email protected]
My Blog     :   http://blog.csdn.net/yeeyee/
QQ          :   282624758
创建时间    ：  2005年5月31日
及最后修改时间：
修改人修改时间：
修改说明：        
版权声明：      版权所有，转载请注明本人邮箱，笔名，
                          并保证文章的完整性。
调用说明：
优缺点说明：  
*}

//用 Model Maker 操作
1、在工程中建立一个类，
2、Run Model Maker
3、Convert Project To Model
4、View 菜单
5、Patterns
6、Apply SingleTon Pattern
7、Good Luck

英语有点差。

//模式

unit SingleTonForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFormSingleTon = class(TForm)
    Edit1: TEdit;
  private
    FAOwner:TComponent;
    procedure SetAOwer(AValue:TComponent);
  protected
    class function AccessInstance(Request: Integer): TFormSingleTon;
  public
    constructor Create;
    constructor CreateInstance;
    destructor Destroy; override;
    class function Instance: TFormSingleTon;
    class procedure ReleaseInstance;
    property AOwner:TComponent read FAOwner write SetAOwer;
  end;
 
var
  FormSingleTon: TFormSingleTon;

implementation

{
******************************** TFormSingleTon ********************************
}

procedure TFormSingleTon.SetAOwer(AValue:TComponent);
begin
  if FAOwner<>AValue then
  begin
    FAOwner:=AValue;
  end;
end;

constructor TFormSingleTon.Create;
begin
  inherited Create(FAOwner);
  raise Exception.CreateFmt('Access class %s through Instance only', [ClassName]);
end;

constructor TFormSingleTon.CreateInstance;
begin
  inherited Create(FAOwner);
end;

destructor TFormSingleTon.Destroy;
begin
  if AccessInstance(0) = Self then AccessInstance(2);
  inherited Destroy;
end;

class function TFormSingleTon.AccessInstance(Request: Integer): TFormSingleTon;
 
  {$J+}
  const FInstance: TFormSingleTon = nil;
  {$J-}
 
begin
  case Request of
    0 : ;
    1 : if not Assigned(FInstance) then FInstance := CreateInstance;
    2 : FInstance := nil;
  else
    raise Exception.CreateFmt('Illegal request %d in AccessInstance', [Request]);
  end;
  Result := FInstance;
end;

class function TFormSingleTon.Instance: TFormSingleTon;
begin
  Result := AccessInstance(1);
end;

class procedure TFormSingleTon.ReleaseInstance;
begin
  AccessInstance(0).Free;
end;

{$R *.dfm}

end.

//1，调用，声明一个 Private 变量
    Private
 FFormSingleTon1:TFormSingleTon;
 FFormSingleTon2:TFormSingleTon;

//2，创建
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  FFormSingleTon1:=TFormSingleTon.Instance;
  FFormSingleTon2:=TFormSingleTon.Instance;
  FFormSingleTon1.Show;
  FFormSingleTon2.Show;
end;

//判断地址是否相等。
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
    if FFormSingleTon1=FFormSingleTon2 then
    begin
      ShowMessage('The Same');
    end
    else
    begin
      ShowMessage('Differ');
    end;   
end;

//释放
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
    FFormSingleTon1.ReleaseInstance;
    FFormSingleTon2.ReleaseInstance;
end;

说明：
1，外部调用函数：
也就是说，想调用这个 窗体，
创建用Instance
释放用ReleaseInstance
    class function Instance: TFormSingleTon;
    class procedure ReleaseInstance;
其余的函数内部使用。

2，
ShowMessage('The Same');
表明创建的窗体的地址相同，也就是说只有一个窗口。
这就是 SingleTon。

3，其余的看刘艺的 Delphi 模式编程。

有问题，请原谅，现在在学校，不是公司，我没有计算机，根据我网上的帖子修改，谢谢。

相关软件：