{*
单元说明 ： 用 ModelMaker 生成 单例程窗体模式。
作者 ：
笔名 ： 易 一 英文名：yeeyee
E-Mail ： jane1437@163.com
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 模式编程。
有问题，请原谅，现在在学校，不是公司，我没有计算机，根据我网上的帖子修改，谢谢。