摘自 daiqingbo 以前的回答：
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)
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等，目前用前者
//当然可以很容易地改变成你所需要的 (beta注)
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.
