{
 TBuffer 可控制增量的缓冲区类
 用于高速在末尾添加数据，并提供了缓冲区溢出处理事件
 By creation_zy
 2002-3-15
}
type
 TBuffer=class
 private
   FBuffer:PChar;
   FMaxBufSize:Integer;
   FIncreasement:Integer;
   FContentSize:Integer;
   FCapacity: Integer;
   function GetAsString: String;
   function Enlarge(NewLen:Integer):Boolean;
 public
   OnBufFull:procedure;
   property MaxBufSize:Integer read FMaxBufSize;
   property ContentSize:Integer read FContentSize;
   property Capacity:Integer read FCapacity;
   property Increasement:Integer read FIncreasement;
   property AsString:String read GetAsString;
   function WriteBuf(P:PChar;Len:Integer):Boolean;
   procedure ClearBuf(FreeMemory:Boolean=true);
   constructor Create(MaxSize:Integer=0;IncreaseSize:Integer=32768); //缺省容量上限为无限大，增量为32K
   destructor Destroy; override;
 end;

implementation

{ TBuffer }

procedure TBuffer.ClearBuf(FreeMemory: Boolean);
begin
 if FreeMemory then
 begin
   FreeMem(FBuffer);
   FBuffer:=nil;
   FCapacity:=0;
 end;
 FContentSize:=0;
end;

constructor TBuffer.Create(MaxSize: Integer; IncreaseSize: Integer);
begin
 FBuffer:=nil;
 if IncreaseSize>0 then
   FIncreasement:=IncreaseSize
 else
   FIncreasement:=32768;
 if MaxSize<0 then
   FMaxBufSize:=0
 else
   FMaxBufSize:=MaxSize;
 FContentSize:=0;
 FCapacity:=0;
 OnBufFull:=nil;
end;

destructor TBuffer.Destroy;
begin
 FreeMem(FBuffer);
 inherited;
end;

function TBuffer.Enlarge(NewLen: Integer): Boolean;
var
 P:PChar;
 Len,IncNum:Integer;
begin
 Result:=false;
 if NewLen<FContentSize then //新的长度无法容纳已有的内容
   exit;
 if (FMaxBufSize>0) and (NewLen>FMaxBufSize) then
 begin
   if Assigned(OnBufFull) then
   begin
     IncNum:=NewLen-FCapacity; //保存增量
     OnBufFull;
     if FContentSize=0 then //如果用户在 OnBufFull 事件中已经清空了缓冲区
       Result:=Enlarge(IncNum);
   end;
   exit;
 end;
 Len:=FIncreasement*((NewLen+FIncreasement-1) div FIncreasement);
 if (FMaxBufSize>0) and (Len>FMaxBufSize) then
   Len:=FMaxBufSize;
 try
   GetMem(P,Len);
 except
   if Assigned(OnBufFull) then
   begin
     IncNum:=Len-FCapacity; //保存增量
     OnBufFull;
     if FContentSize=0 then //...
       Result:=Enlarge(IncNum);
   end;
   exit;
 end;
 Result:=true;
 Move(FBuffer^,P^,FContentSize);
 FreeMem(FBuffer);
 FCapacity:=Len;
 FBuffer:=P;
end;

function TBuffer.GetAsString: String;
begin
 SetLength(Result,FContentSize);
 Move(FBuffer^,Result[1],FContentSize);
end;

function TBuffer.WriteBuf(P: PChar; Len: Integer): Boolean;
var
 PC:PChar;
begin
 if FContentSize+Len>FCapacity then
   Result:=Enlarge(FContentSize+Len)
 else
   Result:=true;
 if Result then
 begin
   PC:=FBuffer+FContentSize;
   Move(P^,PC^,Len);
   Inc(FContentSize,Len);
 end;
end;


将上面的算法中的Memo1.Lines.Add(mstr);改为：
mstr:=mstr+#13#10;
Buf.WriteBuf(@mstr[1],Length(mstr));

将 function BallInBox 的执行部分改为：
begin
 Result:=0;
 if (BallColorNum*BallNumPerColor>BoxNum*BoxSpace) //球的总数大于总空间数
   or (BallColorNum*BallNumPerColor<BoxNum*MinBallNumInBox) then  //不满足每盒最小球数
   exit;
 Buf:=TBuffer.Create; //*************
 SetLength(Ball,BallColorNum*BallNumPerColor);
 SetLength(Box,BoxNum);
 FillChar(Ball[0],BallColorNum*BallNumPerColor*4,0);
 FillChar(Box[0],BoxNum*4,0);
 DoLevel(0);
 Form1.Memo1.Text:=Buf.AsString; //*************
 Buf.Free; //**************
end;