我做了一个程序，不过我觉得不太好，各位有何高招？
附上我的源码：
unit uDataArr;
interface
type
TDataArr=array[0..8] of Byte;
RReturn=record
Data2:Integer;
Data3:Integer;
i:Integer;
j:Integer;
m:Integer;
n:Integer;
p:Integer;
Relt:Integer;
end;
RReturnArr=array of RReturn;
const
DataArr:TDataArr=(1,2,3,4,5,6,7,8,9);
var
RetDataArr:RReturnArr;
implementation
end.
unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,uDataArr;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure TwoData;
procedure ThreeData( i:integer; j: integer;out RetData: RReturn);
function ResultAnly(const Data:RReturn):Boolean;
function JudRe(x:integer;const Data:RReturn):Boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.JudRe(x: integer; const Data: RReturn): Boolean;
begin
if not( x in [Data.i,Data.j,Data.m,Data.n,Data.p]) then
result:=true
else
result:=false;
end;
function TForm1.ResultAnly(const Data:RReturn):Boolean;
var
a,b,c,d:Integer;
begin
Result:=true;
a:=(Data.Relt)div 1000;
b:=(Data.Relt-a*1000)div 100;
c:=(Data.Relt-a*1000-b*100)div 10;
d:=(Data.Relt-a*1000-b*100-c*10);
if ((a*b*c*d)=0) then
begin
Result:=false;
exit;
end;
if (not (a in [b,c,d]))and(not (b in [a,c,d])) and(not (c in [a,b,d]))
and(not (d in [a,b,c])) then
begin
if not JudRe(a-1,Data) then
begin
Result:=False;
Exit;
end;
if not JudRe(b-1,Data) then
begin
Result:=False;
Exit;
end;
if not JudRe(c-1,Data) then
begin
Result:=False;
Exit;
end;
if not JudRe(d-1,Data) then
begin
Result:=False;
Exit;
end;
end else
begin
Result:=False;
end;
end;
procedure TForm1.ThreeData(i:integer; j: integer; out RetData: RReturn);
var
m,n,p:integer;
begin
for m:=0 to Length(DataArr)-1 do
begin
if (m in [i,j]) then continue;
for n:=0 to Length(DataArr)-1 do
begin
if (n in [m,i,j]) then continue;
for p:=0 to Length(DataArr)-1 do
begin
if (p in [m,n,i,j]) then continue;
RetData.Data3:=DataArr[m]*100+DataArr[n]*10+DataArr[p];
RetData.m:=m;RetData.n:=n;RetData.p:=p;
RetData.i:=i;RetData.j:=j;
RetData.Relt:=RetData.Data2*RetData.Data3;
if ((RetData.Relt<1000)or(RetData.Relt>9999)) then continue;
if ResultAnly(RetData) then
begin
Setlength(RetDataArr,Length(RetDataArr)+1);
RetDataArr[Length(RetDataArr)-1]:=RetData;
//ShowMessage(IntToStr(RetData.Data2)+' '+IntToStr(RetData.Data3)+' '+IntToStr(RetData.Relt));
//exit;
end;
end;
end;
end;
end;
procedure TForm1.TwoData;
var
i,j,Index:integer;
Data:RReturn;
ReStr:String;
begin
Finalize(RetDataArr);
ReStr:='';
for i:=0 to Length(DataArr)-1 do
begin
for j:=0 to Length(DataArr)-1 do
if i<>j then
begin
Data.Data2:=(DataArr[i]*10+DataArr[j]);
ThreeData(i,j,Data) ;
end;
end;
for Index:=0 to Length(RetDataArr)-1 do
begin
ReStr:=ReStr+#13#10+IntToStr(RetDataArr[Index].Data2)+' '+IntToStr(RetDataArr[Index].Data3)+' '+IntToStr(RetDataArr[Index].Relt);
end;
ShowMessage(ReStr);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TwoData;
end;
6 个解决方案
#1
我的程序运行结果为：
12 483 5796
18 297 5346
27 198 5346
28 157 4396
39 186 7254
42 138 5796
48 159 7632
12 483 5796
18 297 5346
27 198 5346
28 157 4396
39 186 7254
42 138 5796
48 159 7632
#2
for i := 10 to 99 do
for n:= 100 to 999 do
begin
b :=True;
s := IntToStr(i * n);
if Length(s)= 4 then
begin
s1 := IntToStr(i);
s2 := IntToStr(n);
s := s1 + '*' + s2 + ' = '+ s;
for g:= 1 to 9 do
begin
if Pos(IntToStr(g),s) < 1 then
b :=False;
end;
if b then
Memo1.Lines.Add(s);
end;
end;
for n:= 100 to 999 do
begin
b :=True;
s := IntToStr(i * n);
if Length(s)= 4 then
begin
s1 := IntToStr(i);
s2 := IntToStr(n);
s := s1 + '*' + s2 + ' = '+ s;
for g:= 1 to 9 do
begin
if Pos(IntToStr(g),s) < 1 then
b :=False;
end;
if b then
Memo1.Lines.Add(s);
end;
end;
#3
var
i,n,g:integer;
s,s1,s2 :string;
b:boolean;
begin
for i := 10 to 99 do
for n:= 100 to 999 do
begin
b :=True;
s := IntToStr(i * n);
if Length(s)= 4 then
begin
s1 := IntToStr(i);
s2 := IntToStr(n);
s := s1 + '*' + s2 + ' = '+ s;
for g:= 1 to 9 do
begin
if Pos(IntToStr(g),s) < 1 then
begin
b :=False;
Break;
end;
end;
if b then
Memo1.Lines.Add(s);
end
else
Break;
end;
end;
#4
红叶兄果然高明，把数值转换为字符串处理!
#5
#6
哪位仁兄还有别的方法吗？
#1
我的程序运行结果为：
12 483 5796
18 297 5346
27 198 5346
28 157 4396
39 186 7254
42 138 5796
48 159 7632
12 483 5796
18 297 5346
27 198 5346
28 157 4396
39 186 7254
42 138 5796
48 159 7632
#2
for i := 10 to 99 do
for n:= 100 to 999 do
begin
b :=True;
s := IntToStr(i * n);
if Length(s)= 4 then
begin
s1 := IntToStr(i);
s2 := IntToStr(n);
s := s1 + '*' + s2 + ' = '+ s;
for g:= 1 to 9 do
begin
if Pos(IntToStr(g),s) < 1 then
b :=False;
end;
if b then
Memo1.Lines.Add(s);
end;
end;
for n:= 100 to 999 do
begin
b :=True;
s := IntToStr(i * n);
if Length(s)= 4 then
begin
s1 := IntToStr(i);
s2 := IntToStr(n);
s := s1 + '*' + s2 + ' = '+ s;
for g:= 1 to 9 do
begin
if Pos(IntToStr(g),s) < 1 then
b :=False;
end;
if b then
Memo1.Lines.Add(s);
end;
end;
#3
var
i,n,g:integer;
s,s1,s2 :string;
b:boolean;
begin
for i := 10 to 99 do
for n:= 100 to 999 do
begin
b :=True;
s := IntToStr(i * n);
if Length(s)= 4 then
begin
s1 := IntToStr(i);
s2 := IntToStr(n);
s := s1 + '*' + s2 + ' = '+ s;
for g:= 1 to 9 do
begin
if Pos(IntToStr(g),s) < 1 then
begin
b :=False;
Break;
end;
end;
if b then
Memo1.Lines.Add(s);
end
else
Break;
end;
end;
#4
红叶兄果然高明，把数值转换为字符串处理!
#5
#6
哪位仁兄还有别的方法吗？