unit ObjectPool;

interface

uses
  Queue,
  Classes, SysUtils, SyncObjs;

type
  TObjectPool = class
  private
    FCapacity : integer;
    FQueue : TQueue;
    FCS : TCriticalSection;
  public
    constructor Create(ACapacity:integer); reintroduce;
    destructor Destroy; override;

    procedure Clear;
    function GetObject(var AObject:TObject):boolean;
    procedure Free(AObject:TObject);
  end;

implementation

{ TObjectPool }

procedure TObjectPool.Clear;
var
  pTemp : TObject;
begin
  FCS.Enter;
  try
    while not FQueue.IsEmpty do begin
      if FQueue.Pop(Pointer(pTemp)) then TObject(pTemp).Free;
    end;
  finally
    FCS.Leave;
  end;
end;

constructor TObjectPool.Create(ACapacity:integer);
begin
  inherited Create;

  FCapacity := ACapacity;
  if FCapacity = 0 then FCapacity := 32;

  FQueue := TQueue.Create(ACapacity);
  FCS := TCriticalSection.Create;
end;

destructor TObjectPool.Destroy;
begin
  Clear;

  SysUtils.FreeAndNil(FQueue);
  SysUtils.FreeAndNil(FCS);

  inherited;
end;

procedure TObjectPool.Free(AObject: TObject);
begin
  FCS.Enter;
  try
    if FQueue.IsFull then begin
      AObject.Free;
      Exit;
    end;

    FQueue.Push(AObject);
  finally
    FCS.Leave;
  end;
end;

function TObjectPool.GetObject(var AObject: TObject): boolean;
begin
  FCS.Enter;
  try
    Result := not FQueue.IsEmpty;
    if not Result then Exit;

    Result := FQueue.Pop(Pointer(AObject));
  finally
    FCS.Leave;
  end;
end;

end.
