以前项目需要做的一个队列类，可能很多人习惯了用Tlist，看过Tlist代码的人知道，其实Tlist有两点不好，一个是每次需要扩展内存都是成倍扩展（2倍还是4倍），如果需要的对象很大，十万百万级别就不太适用了。另一个是对于先进先出的情况下每次出列都要整体移动一次内存，在队列数量庞大时比较耗系统开销。

{*******************************************************************************
  Project:    Project1
  Module:     uSeq.pas
  Designer:   Shappy
  Date:       2006-7-7 14:50:27
  Remark:
}

unit uSeq;
interface
uses classes, SysUtils, Windows;

type
  TSeque=class
  private
    FSeq:PPointerList;
    FHead,FTail:integer;
    FCount,FCapicity:integer;
    FCriticalSection:TRTLCriticalSection;
  protected
    procedure Enter;
    procedure Leave;
  public
    property Count:Integer read FCount;
    property Capicity:integer read FCapicity;
    constructor Create(iCapicity:Integer);
    destructor Destroy;
    function Push(item:Pointer):Boolean;
    function Pop:Pointer;
    function printBuf:string;
  end;

implementation

{ TSeque }

constructor TSeque.Create(iCapicity: Integer);
begin
  if iCapicity<=0 then iCapicity:=100;
  FCapicity:=iCapicity;
  GetMem(FSeq,FCapicity*SizeOf(Pointer));
  FHead:=0;
  FTail:=0;
  FCount:=0;
  InitializeCriticalSection(FCriticalSection);
end;

destructor TSeque.Destroy;
begin
  FreeMem(FSeq,FCapicity*SizeOf(Pointer));
  DeleteCriticalSection(FCriticalSection);
end;

procedure TSeque.Enter;
begin
  EnterCriticalSection(FCriticalSection);
end;

procedure TSeque.Leave;
begin
  LeaveCriticalSection(FCriticalSection);
end;

function TSeque.Pop: Pointer;
begin
  if (FHead=FTail) and (FCount=0) then
    result:=nil
  else begin
    enter;
    result:=FSeq^[Fhead];
    Inc(FHead);
    Dec(FCount);
    Leave;
  end;
end;

function TSeque.printBuf: string;
var
  i:integer;
begin
  result:='';
  for i:=FHead to FTail-1 do
    result:=result+inttostr(i)+' '+inttohex(Integer(FSeq^[i]),4)+#13#10;
end;

function TSeque.Push(item: Pointer): Boolean;
begin
  result:=false;
  if (FHead=FTail) and (FCount>0) or (item=nil) then
    exit  //full
  else
//    try
      enter;
      FSeq^[FTail]:=item;
      Inc(FTail);
      Inc(FCount);
//    finally
      leave;
//    end;
  result:=true;
end;

end.