编程实现"小学二年级暑期作业智力题"(200分)

我看大家都有点离题了，小学二年级的数学题，没理由有那么多的组合，先看看：
用[yellow]0,1,2,3,4,5,6,7,8,9[/yellow] 十个数，组成一个等式([blue]两个三位数相加等于一个四位数[/blue]),
[green]且每个数不能重复使用[/green]。如: xxx+xxx=xxxx
手工推算的话是可以，但要得出所有解的话也不简单。所以想程序实现，大家各显身手吧！
有分又好玩。
[green]且每个数不能重复使用[/green]就是指10个数字不能重复出现，同时为了满足结果为四位数
那么其组合应该是不多的，先应将10个数组合成三组三位数，然后在看这三组数哪两组能
相加得到四位数
编写思路职下：
1.先得出10个数的组合
2.筛选出满足三组三位数没有重复数字的数组（存在一个三维数组array1中）
a.在1的集合里任意提取一个number1（提取是指要在原集中删除这个数）;
b.在1的集合里提取第二个数number2，满足数字不重复。
c.在1的集合里提取第三个数number3，满足数字不重复。
d.重复c.直到在第一，第二个数不变的情况下得出所有的第三个数。（不大于3个）
e.重复a-d得出所在的数组；
3.对数组array1进行循环检测三个数的其中两个数是否满足相加结果为四位数的条件，
满足则将其存在一个二维数组中。

把题目写得严谨些，
如果 1 + 2 = 3 是一种答案，那么 2 + 1 = 3 是不是一个答案呢？
等等...

以下是算法源码：
var i,i1,i2,i3,i4,i5,i6,n1,n2,n3 : Integer;
s,s1,s2,s3:string;
b : Boolean;
procedure setnum;
begin
s := '023456789';
s1[1] := s[i1];
delete(s,i1,1);
s1[2] := s[i2];
delete(s,i2,1);
s1[3] := s[i3];
delete(s,i3,1);
s2[1] := s[i4];
delete(s,i4,1);
s2[2] := s[i5];
delete(s,i5,1);
s2[3] := s[i6];
delete(s,i6,1);
end;

begin
//根据题意，和的高位只能是1
//剩下的9个数再左边的6个位置全排列
s1 := '123';
s2 := '123';
for i1 := 1 to 9 do
for i2 := 1 to 8 do
for i3 := 1 to 7 do
for i4 := 1 to 6 do
for i5 := 1 to 5 do
for i6 := 1 to 4 do
begin
setnum;
//判断算式是否正确
n1 := strtoint(s1);
n2 := strtoint(s2);
n3 := n1 + n2;
s3 := inttostr(n3);
if (s1[1] <> '0') and (s2[1] <> '0') and (s3[1] = '1') then
begin
b := True;
for i := 1 to Length(s3) do
if pos(s3,s+'1') < 1 then
begin
b := False;
break;
end;
if b then
for i := 1 to length(s) do
if pos(s,s3) < 1 then
begin
b := False;
break;
end;
if b then
for i := 1 to length(s3) do
if (pos(s3,s3)>0) and (pos(s3,s3)<>i) then
begin
b := False;
break;
end;
if b then
memo1.Lines.Add(s1+'+'+s2+'='+s3);
end;
end;
end;
以下是结果（96种）：
246+789=1035
249+786=1035
264+789=1053
269+784=1053
284+769=1053
286+749=1035
289+746=1035
289+764=1053
324+765=1089
325+764=1089
342+756=1098
346+752=1098
347+859=1206
349+857=1206
352+746=1098
356+742=1098
357+849=1206
359+847=1206
364+725=1089
365+724=1089
423+675=1098
425+673=1098
426+879=1305
429+876=1305
432+657=1089
437+589=1026
437+652=1089
439+587=1026
452+637=1089
457+632=1089
473+589=1062
473+625=1098
475+623=1098
476+829=1305
479+583=1062
479+826=1305
483+579=1062
487+539=1026
489+537=1026
489+573=1062
537+489=1026
539+487=1026
573+489=1062
579+483=1062
583+479=1062
587+439=1026
589+437=1026
589+473=1062
623+475=1098
624+879=1503
625+473=1098
629+874=1503
632+457=1089
637+452=1089
652+437=1089
657+432=1089
673+425=1098
674+829=1503
675+423=1098
679+824=1503
724+365=1089
725+364=1089
742+356=1098
743+859=1602
746+289=1035
746+352=1098
749+286=1035
749+853=1602
752+346=1098
753+849=1602
756+342=1098
759+843=1602
764+289=1053
764+325=1089
765+324=1089
769+284=1053
784+269=1053
786+249=1035
789+246=1035
789+264=1053
824+679=1503
826+479=1305
829+476=1305
829+674=1503
843+759=1602
847+359=1206
849+357=1206
849+753=1602
853+749=1602
857+349=1206
859+347=1206
859+743=1602
874+629=1503
876+429=1305
879+426=1305
879+624=1503

to zhukewen:
324+765=1089
765+324=1089
这个也算一种吗？里面相似的组合还有很多！
我认为这决不是一种，因为这没有顺序关系！

答案应该是48种,或96种（1 + 2 = 3 是一种答案， 2 + 1 = 3 也算是一个答案）
张辉明为什么漏掉：479+826=1305 ？
我的源码：
function TForm1.isOk(i, j: integer): boolean;
var
a: array[1..10] of byte;
m, n, s: byte;
begin
result := false;
a[1] := i div 100;
a[2] := (i - 100 * a[1]) div 10;
a[3] := i - 100 * a[1] - a[2] * 10;
a[4] := j div 100;
a[5] := (j - 100 * a[4]) div 10;
a[6] := j - 100 * a[4] - a[5] * 10;
a[7] := (i + j) div 1000;
a[8] := ((i + j) - 1000 * a[7]) div 100;
a[9] := ((i + j) - 1000 * a[7] - 100 * a[8]) div 10;
a[10] := ((i + j) - 1000 * a[7] - 100 * a[8] - 10 * a[9]);
for m := 1 to 9 do
for n := m + 1 to 10 do
if a[n] = a[m] then
begin
result := true;
exit;
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
i, j: integer;
begin
RichEdit1.lines.clear;
i := 100;
j := 101;
while i < 999 do
begin
j:=101;
//96种
//j := i + 1;//48种
while j < 1000 do
begin
if (i + j > 999) then
begin
if isok(i, j) = false then
RichEdit1.lines.add( intToStr(i) + '+' + IntToStr(j)+ '=' +IntToStr(i + j));
end;
inc(j);
end;
inc(i);
end;
showmessage(IntToStr(RichEdit1.lines.count));
end;

嗯，已发现了，改成这样就不会有事了。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
ta=array[1..10] of integer;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
function istrue(a:ta):boolean;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
var x:integer;
{$R *.dfm}
{ TForm1 }
function TForm1.istrue(a: ta): boolean;
var
i,j:integer;
begin
result:=False;
for i:=1 to 9 do
begin
for j:=i+1 to 10 do
if a=a[j] then
begin
result:=true;
exit;
end;
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var a:ta;
i,j,s,k:integer;
begin
x:=0;
for i:=201 to 987 do
begin
a[1]:=i div 100;
a[2]:=(i-a[1]*100) div 10;
a[3]:=i mod 10;
for j:=4 to 10 do
a[j]:=j-20;
if istrue(a) then
Continue;
for j:=201 to 987 do
begin
a[4]:=j div 100;
a[5]:=(j-a[4]*100) div 10;
a[6]:=j mod 10;
for k:=7 to 10 do
a[k]:=k-20;
if istrue(a) then
continue
else
begin
s:=i+j;
a[7]:=s div 1000;
if a[7]=0 then
continue;
a[8]:=s div 100 mod 10;
a[9]:=s div 10 mod 10;
a[10]:=s mod 10;
if istrue(a) then
continue
else
begin
inc(x);
listbox1.Items.Add(inttostr(x)+': '+inttostr(i)+'+'+inttostr(j)+'='+inttostr(s));
end;
end;

end;
end;
end;

end.

这种问题我只有学习了。
因为我上次那个问题就没有解决。
谁帮我一把
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1213823

用递归方法实现，不足之处，请大家提意见。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
CheckBox2: TCheckBox;
Label1: TLabel;
procedure getlist(gs : integer;
ss : array of integer);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
z : integer;
s : array [0..9] of integer;
da : string;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.getlist(gs : integer;
ss : array of integer);
var
i, j, js1, js2, jg: integer;
ns : array of integer;
hf : boolean;
//用来判断取出的数据的合法性，如果符合题意，则加入到listbox中。
begin
hf := true;
if gs = 0 then
begin
//加数不可能是0开头
if ((copy(da, 1, 1) = '0') or (copy(da, 4, 1) = '0')) then
hf := false;
//判断结果是否允许0开头
if not checkbox2.Checked then
if copy(da, 7, 1) = '0' then
hf := false;
if hf then
begin
//为FORM增加效果，不至于看上去象死机一样
z := z + 1;
if z mod 100000 = 0 then
label1.Caption := label1.Caption + '.';
if z mod 500000 = 0 then
label1.Caption := '正在计算中';
form1.Update;
//验算
js1 := strtoint(copy(da, 1, 3));
js2 := strtoint(copy(da, 4, 3));
jg := strtoint(copy(da, 7, 4));
if js1 + js2 = jg then
listbox1.Items.add(copy(da, 1, 3) + ' + ' + copy(da, 4, 3) + ' = ' + copy(da, 7, 4));
end;
end
else
begin
for i := 1 to gs do
begin
//从数组中取出一个数，共有gs种可能
da := da + inttostr(ss[i - 1]);
//从原来的数组中去掉取出的数，成为新的数组
setlength(ns, gs - 1);
for j := 1 to gs - 1 do
if j < i then
ns[j - 1] := ss[j - 1]
else
if j >= i then
ns[j - 1] := ss[j];
//递归调用
getlist(gs - 1, ns);
//除去上次取的数
da := copy(da, 1, length(da) - 1);
end;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
i : integer;
begin
for i := 0 to 9 do
s := i;
z := 0;
label1.caption := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
button1.Enabled := false;
label1.Caption := '正在计算中';
form1.Update;
listbox1.Items.Clear;
getlist(10, s);
label1.Caption := '共有结果' + inttostr(listbox1.items.count) + '种。(组合' + inttostr(z) + ')';
button1.Enabled := true;
end;

end.

gz

over