[?]how to write a singleton class using delphi?(100分)

  • 主题发起人 主题发起人 keenfly
  • 开始时间 开始时间
K

keenfly

Unregistered / Unconfirmed
GUEST, unregistred user!
[?]how to write a singleton class using delphi? please list out the source code. thanks.
 
to keenfly:
下面是一个大概的例子,从 TSingleton 继承的类都自动实现了 Singlton 模式。
unit Singleton;
interface
uses Classes;

type

TSingleton = class
public
class function NewInstance: TObject
override;
procedure FreeInstance
override;
end;

implementation

var
SingletonClassList: TList;
SingletonInstRefList: TList;
SingletonInstList: TList;

{ TSingleton }

procedure TSingleton.FreeInstance;
var
i: Integer;
j : Pointer;
begin
i := SingletonClassList.IndexOf(Pointer(Self.ClassType));
j := SingletonInstRefList.Items;
Dec(Longint(j));
if (Longint(j) = 0) then
begin
SingletonClassList.Delete(i);
SingletonInstRefList.Delete(i);
SingletonInstList.Delete(i);
inherited;
end
else
SingletonInstRefList.Items := j;
end;

class function TSingleton.NewInstance: TObject;
var
i : Integer;
j : Pointer;
begin
i := SingletonClassList.IndexOf(Pointer(Self));
if (i < 0) then
begin
Result := Inherited NewInstance;
SingletonClassList.Add(Pointer(Self));
SingletonInstRefList.Add(Pointer(1));
SingletonInstList.Add(Pointer(Result));
end
else begin
j := SingletonInstRefList.Items;
Inc(Longint(j));
SingletonInstRefList.Items := j;
Result := TObject(SingletonInstList.Items);
end

end;

initialization
SingletonClassList := TList.Create;
SingletonInstRefList := TList.Create;
SingletonInstList := TList.Create;
finalization
SingletonClassList.Free;
SingletonInstRefList.Free;
SingletonInstList.Free;
end.

你可以试试:
...
uese Singleton;
...
type
Ta = class(TSingleton)
Fa : Integer;
end;

Tb = class(TSingleton)
Fb : string;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a, aa: Ta;
b, bb: Tb;
begin
a := Ta.Create;
a.Fa := 100;
aa := Ta.Create;
a.Free;
ShowMessage(IntToStr(aa.Fa));
aa.Free;
b := Tb.Create;
b.Fb := 'asdfsa';
bb := Tb.Create;
b.Free;
ShowMessage(bb.Fb);
bb.Free;
end;
对 a 数据的修改会另到 aa 的数据也改变,实际是同一份数据。
 
接受答案了.
 

Similar threads

A
回复
0
查看
400
Andreas Hausladen
A
A
回复
0
查看
932
Andreas Hausladen
A
A
回复
0
查看
806
Andreas Hausladen
A
A
回复
0
查看
719
Andreas Hausladen
A
后退
顶部