簡單的Delphi對象管理器

《摻和比試

》時得到的一個副產品。

原理很簡單，就是建立的對象放到一個池裡，暫時不釋放，再分配的時候可以重用。對於需要反覆大量建立刪除同一個類的對象時，或是建立對象成本很高的情況下，這個東東有一定的作用。

使用方法：

uses objmngr;<br />Type<br /> TDummy = Class(....<br /> Function Init(...) : TDummy;<br /> ...<br /> End;<br />Var<br /> DummyPool : TMObjPool;<br />...<br />Function TDummy.Init(...) : TDummy;<br />Begin<br /> ...<br /> Result := Self;<br />End;<br />...<br />Var<br /> om : IMObjManager;<br />Begin<br /> om := TMObjManager.Create(DummyPool, 50);<br /> d1 := (om.New As TDummy).Init(...); // Create new dummy object<br /> ...<br />End; // om and all new dummy objects will be released automatically<br />Initialization<br /> DummyPool := TMObjPool.Create(TDummy, 5000);<br />Finallization<br /> DummyPool.Free;

注意：因為自動建立對象時無法確定建構函式參數，所以只能調用無參數的建構函式，如需初始化對象，則需要再定義一個Init函數供調用。因為Init函數取代了建構函式的功能，所以還需要它返回Self給調用者。

嵌入式管理單元objmngr.pas源碼：

unit objmngr;<br />{$IFDEF FPC}{$mode objfpc}{$H+}{$ENDIF}<br />interface<br />uses<br /> Classes, SysUtils;<br />Type<br />TMBucket = Record<br /> Key : TObject;<br /> Value : TObject;<br />end;<br />PMBucket = ^TMBucket;<br />TMHashMap = Class(TObject)<br />Private<br /> FSize : Integer;<br /> FItems : Array Of TMBucket;<br />Protected<br /> Function HashFunc(Key : TObject) : Integer;<br /> Function FindKey(Key : TObject) : Integer;<br /> Function FindEmpty(Key : TObject) : Integer;<br /> Function GetItem(Key : TObject) : TObject;<br />Public<br /> Constructor Create(ASize : Integer);<br /> Destructor Destroy; Override;<br /> Procedure AddItem(Key, Value : TObject);<br /> Procedure DelItem(Key : TObject);<br /> Function PopItem(Key : TObject) : TObject;<br /> Property Items[Key : TObject] : TObject Read GetItem;<br />End;<br />TMStack = Class(TObject)<br />Private<br /> FData : Array Of TObject;<br /> FTop : Integer;<br />Public<br /> Constructor Create(ASize : Integer);<br /> Destructor Destroy; Override;<br /> Procedure Push(AObj : TObject);<br /> Function Pop : TObject;<br /> Function IsEmpty : Boolean;<br />End;<br />TMObjPool = Class(TObject)<br />Private<br /> FMeta : TClass;<br /> FPool : Array Of TObject;<br /> FIndex : Integer;<br /> FMap : TMHashMap;<br /> FFree : TMStack;<br />Public<br /> Constructor Create(AMeta : TClass; ASize : Integer);<br /> Destructor Destroy; Override;<br /> Function NewObj : TObject;<br /> Procedure FreeObj(AObj : TObject);<br />End;<br />IMObjManager = Interface<br /> Function New : TObject;<br />End;<br />TMObjManager = Class(TInterfacedObject, IMObjManager)<br />Private<br /> FPool : TMObjPool;<br /> FObjs : TMStack;<br />Public<br /> Function New : TObject;<br /> Constructor Create(APool : TMObjPool; ASize : Integer = 1000);<br /> Destructor Destroy; Override;<br />End;<br />implementation<br />{ TMHashMap }<br />Constructor TMHashMap.Create(ASize : Integer);<br />Begin<br /> FSize := ASize;<br /> SetLength(FItems, FSize);<br /> FillChar(FItems[0], FSize * SizeOf(TMBucket), 0);<br />End;<br />Destructor TMHashMap.Destroy;<br />Begin<br /> SetLength(FItems, 0);<br /> Inherited;<br />End;<br />Function TMHashMap.HashFunc(Key : TObject) : Integer;<br />Begin<br /> Result := Integer(Key) Mod FSize;<br />End;<br />Function TMHashMap.FindKey(Key : TObject) : Integer;<br />Var<br /> i, n : Integer;<br />Begin<br /> n := HashFunc(Key);<br /> Result := -1;<br /> If FItems[n].Key = Key Then<br /> Result := n<br /> Else<br /> Begin<br /> i := n;<br /> Repeat<br /> i := (i + 1) Mod FSize;<br /> If FItems[i].Key = Key Then<br /> Begin<br /> Result := i;<br /> Break;<br /> End;<br /> Until i = n;<br /> End;<br />End;<br />Function TMHashMap.FindEmpty(Key : TObject) : Integer;<br />Var<br /> i, n : Integer;<br />Begin<br /> n := HashFunc(Key);<br /> If Integer(FItems[n].Key) = 0 Then<br /> Result := n<br /> Else<br /> Begin<br /> i := n;<br /> Repeat<br /> i := (i + 1) Mod FSize;<br /> If Integer(FItems[i].Key) = 0 Then<br /> Begin<br /> Result := i;<br /> Exit;<br /> End;<br /> Until i = n;<br /> Raise Exception.Create('Map is full!');<br /> End;<br />End;<br />Function TMHashMap.GetItem(Key : TObject) : TObject;<br />Var<br /> i : Integer;<br />Begin<br /> i := FindKey(Key);<br /> If i >= 0 Then<br /> Result := FItems[i].Value<br /> Else<br /> Result := Nil;<br />End;<br />Procedure TMHashMap.AddItem(Key, Value : TObject);<br />Var<br /> i : Integer;<br />Begin<br /> i := FindEmpty(Key);<br /> FItems[i].Key := Key;<br /> FItems[i].Value := Value;<br />End;<br />Procedure TMHashMap.DelItem(Key : TObject);<br />Var<br /> i : Integer;<br />Begin<br /> i := FindKey(Key);<br /> If i >= 0 Then<br /> Begin<br /> FItems[i].Key := TObject(0);<br /> FItems[i].Value := Nil;<br /> End;<br />End;<br />Function TMHashMap.PopItem(Key : TObject) : TObject;<br />Var<br /> i : Integer;<br />Begin<br /> i := FindKey(Key);<br /> If i >= 0 Then<br /> Begin<br /> Result := FItems[i].Value;<br /> FItems[i].Key := TObject(0);<br /> FItems[i].Value := Nil;<br /> End<br /> Else<br /> Result := Nil;<br />End;<br />{ TMStack }<br />Constructor TMStack.Create(ASize : Integer);<br />Begin<br /> SetLength(FData, ASize);<br /> FTop := 0;<br />end;<br />Destructor TMStack.Destroy;<br />Begin<br /> SetLength(FData, 0);<br /> Inherited;<br />end;<br />Procedure TMStack.Push(AObj : TObject);<br />Begin<br /> FData[FTop] := AObj;<br /> Inc(FTop);<br /> If FTop >= Length(FData) Then<br /> Raise Exception.Create('Queue is full!');<br />end;<br />Function TMStack.Pop : TObject;<br />Begin<br /> If FTop = 0 Then<br /> Raise Exception.Create('Queue is empty!');<br /> Dec(FTop);<br /> Result := FData[FTop];<br />end;<br />Function TMStack.IsEmpty : Boolean;<br />Begin<br /> Result := (FTop = 0);<br />end;<br />{ TMObjPool }<br />Constructor TMObjPool.Create(AMeta : TClass; ASize : Integer);<br />Begin<br /> FMeta := AMeta;<br /> SetLength(FPool, ASize);<br /> FIndex := 0;<br /> FMap := TMHashMap.Create(ASize * 4);<br /> FFree := TMStack.Create(ASize);<br />End;<br />Destructor TMObjPool.Destroy;<br />Var<br /> i : Integer;<br />Begin<br /> FFree.Free;<br /> FMap.Free;<br /> For i := 0 To FIndex - 1 Do<br /> FPool[i].Free;<br /> Inherited;<br />End;<br />Function TMObjPool.NewObj : TObject;<br />Var<br /> i : Integer;<br />Begin<br /> If FFree.IsEmpty Then<br /> Begin<br /> Result := FMeta.Create;<br /> FPool[FIndex] := Result;<br /> i := FIndex;<br /> Inc(FIndex);<br /> End<br /> Else<br /> Begin<br /> i := Integer(FFree.Pop);<br /> Result := FPool[i];<br /> End;<br /> FMap.AddItem(Result, TObject(i));<br />End;<br />Procedure TMObjPool.FreeObj(AObj : TObject);<br />Var<br /> i : Integer;<br />Begin<br /> i := Integer(FMap.PopItem(AObj));<br /> FFree.Push(TObject(i));<br />End;<br />{ TMObjManager }<br />Constructor TMObjManager.Create(APool : TMObjPool; ASize : Integer);<br />Begin<br /> FPool := APool;<br /> FObjs := TMStack.Create(ASize);<br />End;<br />Destructor TMObjManager.Destroy;<br />Begin<br /> While Not FObjs.IsEmpty Do<br /> FPool.FreeObj(FObjs.Pop);<br /> FObjs.Free;<br /> Inherited;<br />end;<br />Function TMObjManager.New : TObject;<br />Begin<br /> Result := FPool.NewObj;<br /> FObjs.Push(Result);<br />end;<br />end.

 

草草寫就，應該還有最佳化的餘地。