简单的Delphi对象管理器

《掺和比试 》时得到的一个副产品。

原理很简单，就是创建的对象放到一个池里，暂时不释放，再分配的时候可以重用。对于需要反复大量创建删除同一个类的对象时，或是创建对象成本很高的情况下，这个东东有一定的作用。

使用方法：

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

注意：因为自动创建对象时无法确定构造函数参数，所以只能调用无参数的构造函数，如需初始化对象，则需要再定义一个Init函数供调用。因为Init函数取代了构造函数的功能，所以还需要它返回Self给调用者。

管理单元objmngr.pas源码：

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

草草写就，应该还有优化的余地。