creation-zy写的不同状态进行组合的程序（各种颜色小球放置不同盒子这类问题的解法）(200分)

creation君，把你的完整代码再贴一次，并加上简要的程序说明。
方便后来人查找，使用。
然后我就加分喽。
creation君，留个email，以后多交流啊。

原来的题目是：12个小球，共3种颜色，每种颜色4个。分在3个不同的盒子里，
每个盒子放4个。求解所有不同的状态。
creation的程序可以解决更加通用的问题。对于有若干状态，
每个状态数目不定的情况下，能找到所有分组的可能。

TBuffer类就不贴出来了——因为没有任何改动。
（见 http://www.delphibbs.com/delphibbs/dispq.asp?lid=968511 ）
{
名称: BallInBox
功能:
输出若干种不同颜色的小球在不同的盒子中的摆放方式。
在同一个盒子内部，只计算不同颜色的球的组合，不记排列顺序。
参数说明：
球的颜色数 BallColorNum
每种颜色的球的数量 BallNumPerColor
盒子数 BoxNum
每盒可容纳的球数 BoxSpace
每盒的最小球数 MinBallNumInBox
作者： creation_zy
时间： 2002-3-15
}
var
BufInc:Integer=0;
//缓冲区增量，初始化为0
Stop:Boolean;
function BallInBox(BallColorNum,BallNumPerColor,
BoxNum,BoxSpace,MinBallNumInBox:Integer):Integer;
var
Ball,Box:array of Integer;
Buf:TBuffer;
StartTimeWord;
proceduredo
Level(Level:Integer);
var //穷举在目前的盒子占用情况下，第Level种颜色的球的可能摆放方式组合
a,j,k:Integer;
mstr:String;
procedure PN(M:Integer);
var
i,s:Integer;
begin
//计算第Level种颜色的球中，第M个的可能位置
if M=BallNumPerColor then
begin
do
Level(Level+1);
exit;
end;
if M=0 then
s:=0
else
s:=Ball[a+M-1];
//起始盒数不能比前面的相同颜色的球小
for i:=s to BoxNum-1do
if Box<BoxSpace then
//若第i个盒子还有空间
begin
Ball[a+M]:=i;
//将第a+M个球放到第i个盒子中
Inc(Box);
PN(M+1);
Dec(Box);
end;
end;
begin
if Level=BallColorNum then
begin
mstr:='';
for j:=0 to BoxNum-1do
begin
if Box[j]<MinBallNumInBox then
exit;
for k:=0 to BallColorNum*BallNumPerColor-1do
if Ball[k]=j then
mstr:=mstr+IntToStr(k div BallNumPerColor);
//第k个球的颜色
mstr:=mstr+#9;
end;
mstr:=mstr+#13#10;
if not Buf.WriteBuf(@mstr[1],Length(mstr)) then
//如果写入缓冲区失败，则停止
Stop:=true;
Inc(Result);
if Result mod 5000=0 then
begin
Form1.Caption:=Format('进度：>%d%% (%.9d Time: %.2fs Buffer Size: %.2fM)',
[Trunc(100*Ball[0]/BoxNum),Result,(GetTickCount-StartTime)/1000,
Buf.ContentSize/(1024*1024)]);
Application.ProcessMessages;
if Stop then
//强制停止
for j:=0 to BoxNum-1do
Box[j]:=BoxSpace*2;
end;
exit;
end;
a:=BallNumPerColor*Level;
if Stop then
exit;
PN(0);
if Stop then
exit;
end;
begin
Result:=0;
if (BallColorNum*BallNumPerColor>BoxNum*BoxSpace) //球的总数大于总空间数
or (BallColorNum*BallNumPerColor<BoxNum*MinBallNumInBox) then
//不满足每盒最小球数
exit;
Buf:=TBuffer.Create(0,BufInc);
SetLength(Ball,BallColorNum*BallNumPerColor);
SetLength(Box,BoxNum);
FillChar(Ball[0],BallColorNum*BallNumPerColor*4,0);
FillChar(Box[0],BoxNum*4,0);
StartTime:=GetTickCount;
do
Level(0);
Form1.Memo1.Text:=Buf.AsString;
Buf.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TWord;
begin
if Button1.Tag=1 then
begin
Button1.Tag:=0;
Stop:=true;
exit;
end;
Button1.Tag:=1;
Button1.Caption:='停止';
Stop:=false;
with Memo1do
begin
Clear;
Lines.begin
Update;
T:=GetTickCOunt;
Caption:=Format('共 %d 个组合 耗时 %d 毫秒',[
BallInBox(SpinEdit1.Value,SpinEdit2.Value,SpinEdit3.Value,
SpinEdit4.Value,SpinEdit5.Value),GetTickCount-T]);
Lines.EndUpdate;
end;
Button1.Caption:='计算!';
Button1.Tag:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.ItemIndex:=0;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
case ComboBox1.ItemIndex of
0: BufInc:=32*1024;
1: BufInc:=64*1024;
2: BufInc:=256*1024;
3: BufInc:=1024*1024;
4: BufInc:=4096*1024;
5: BufInc:=16384*1024;
end;
end;

另附DFM文件：
object Form1: TForm1
Left = 150
Top = 152
Width = 508
Height = 310
BorderIcons = [biSystemMenu]
Caption = 'Balls in Boxes'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 12
object SpinEdit1: TSpinEdit
Left = 118
Top = 10
Width = 49
Height = 21
MaxLength = 2
MaxValue = 99
MinValue = 1
TabOrder = 0
Value = 3
end
object Memo1: TMemo
Left = 172
Top = 0
Width = 328
Height = 283
Align = alRight
Anchors = [akLeft, akTop, akRight, akBottom]
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 1
end
object SpinEdit2: TSpinEdit
Left = 118
Top = 42
Width = 49
Height = 21
MaxLength = 2
MaxValue = 99
MinValue = 1
TabOrder = 2
Value = 3
end
object StaticText1: TStaticText
Left = 52
Top = 16
Width = 64
Height = 16
Caption = '球的颜色数'
TabOrder = 3
end
object StaticText2: TStaticText
Left = 4
Top = 48
Width = 112
Height = 16
Caption = '每种颜色的球的数量'
TabOrder = 4
end
object Button1: TButton
Left = 52
Top = 176
Width = 75
Height = 25
Caption = '计算!'
TabOrder = 5
OnClick = Button1Click
end
object SpinEdit3: TSpinEdit
Left = 118
Top = 74
Width = 49
Height = 21
MaxLength = 2
MaxValue = 99
MinValue = 1
TabOrder = 6
Value = 3
end
object SpinEdit4: TSpinEdit
Left = 118
Top = 106
Width = 49
Height = 21
MaxLength = 2
MaxValue = 99
MinValue = 1
TabOrder = 7
Value = 3
end
object StaticText3: TStaticText
Left = 76
Top = 80
Width = 40
Height = 16
Caption = '盒子数'
TabOrder = 8
end
object StaticText4: TStaticText
Left = 16
Top = 112
Width = 112
Height = 16
Caption = '每盒可容纳的球数'
TabOrder = 9
end
object SpinEdit5: TSpinEdit
Left = 118
Top = 138
Width = 49
Height = 21
MaxLength = 2
MaxValue = 99
MinValue = 0
TabOrder = 10
Value = 0
end
object StaticText5: TStaticText
Left = 28
Top = 144
Width = 100
Height = 16
Caption = '每盒的最小球数'
TabOrder = 11
end
object ComboBox1: TComboBox
Left = 102
Top = 218
Width = 65
Height = 20
Style = csDropDownList
ItemHeight = 12
TabOrder = 12
OnChange = ComboBox1Change
Items.Strings = (
'32K'
'64K'
'256K'
'1M'
'4M'
'16M')
end
object StaticText6: TStaticText
Left = 34
Top = 224
Width = 64
Height = 16
Caption = '缓冲区增量'
TabOrder = 13
end
end

忘了写Mail: creation_zy@sina.com
(我也不是科班出身喲)

[]see you next time.