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 的数据也改变,实际是同一份数据。