看到一道题。。。。。。(200分)

居然忘了贴代码
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure p(n: integer);
var
Form1: TForm1;

implementation

{$R *.DFM}

procedure p(n: integer)
//by daiqingbo@netease.com
var
fact: array of longint
//储存n!
o: array of integer
//储存递增进制输出
op: string
//储存字符串输出
i, j, temp: longint;
symbol: array of string
//储存排列的元素,如1，2，3，4，5 或者a,b,c,d,e等，目前用前者

procedure inctostring
//递增进制数到字符串输出
var i, j: integer;
begin
op := '';
for i := 0 to n - 1 do
symbol := inttostr(i + 1)
//存入 1，2，3，4，5 ...
for i := 0 to n - 1 do
begin
op := op + symbol[o];
for j := o to n - 2-i do
symbol[j] := symbol[j + 1];
end;
end;

begin
setlength(fact, n);
setlength(symbol, n);
setlength(o, n);
fact[0] := 1;
for i := 1 to n - 1 do
fact := (i + 1) * fact[i - 1];
for i := 0 to fact[n - 1] - 1 do
begin
temp := i;
for j := 0 to n - 2 do
begin
o[j] := temp div fact[n - 2 - j];
temp := temp mod fact[n - 2 - j];
end;
o[n - 1] := 0
//最后一个元素，只有一个可供选择的元素
inctostring;
form1.memo1.lines.add(op)
//要改变输出，请修改这一句
end;


end;

procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Clear;
p(5);
end;

end.

这种程序5年没写了
有BASIC的
要吗?

为什么要限制不用递归呢?

修改了一下，主程序只用一重循环，而且不用计算除法，效率应该提高很多，也更符合设想。
倒是转换输出部分用了两重循环，瓶颈应该在这里。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure p(n: integer);
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure p(n: integer)
//by daiqingbo@netease.com
var
fact: longint
//储存n!
o: array of integer
//储存递增进制输出
op: string
//储存字符串输出
i: longint;
symbol: array of string
//储存排列的元素,如1，2，3，4，5 或者a,b,c,d,e等，目前用前者
procedure inctostring
//递增进制数到字符串输出
var i, j: integer;
begin
op := '';
for i := 0 to n - 1 do
symbol := inttostr(i + 1)
//存入 1，2，3，4，5 ...
for i := 0 to n - 1 do
begin
op := op + symbol[o];
for j := o to n - 2 - i do
symbol[j] := symbol[j + 1];
end;
end;

procedure arrange
//处理进位
var i: integer;
begin
for i := n - 2 downto 0 do
if o = n - i then
begin
o := 0;
o[i - 1] := o[i - 1] + 1;
end;
end;

begin
setlength(symbol, n);
setlength(o, n);
fact := 1;
for i := 2 to n do
fact := fact * i
//fact:=n!
inctostring
//o 缺省为全为0
form1.memo1.lines.add(op)
//要改变输出，请修改这一句
for i := 1 to fact - 1 do
begin
o[n - 2] := o[n - 2] + 1;
arrange;
inctostring;
form1.memo1.lines.add(op)
//要改变输出，请修改这一句
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Clear;
p(6)

end;

end.

接受答案了.

恐怖