ЗаплачУ или заплАчу?
Ладно, получай даром
var k:array[1..11]of longint; m,l:longint; i,j,n:integer; p,s:string;
begin
for i:=1 to 11 do k[ i]:=0; l:=1000000; s:='';
write('n ? '); readln(n); k[1]:=1;
for i:=1 to n do
begin m:=0; for j:=1 to 11 do begin k[j]:=k[ j]*i+m; m:=k [j] div l;
k[ j]:=k[ j] mod l end end;
for j:=11 downto 1 do begin str(k[ j]:6,p); s:=s+p end;
for j:=1 to length(s) do if s[ j]=' ' then s[ j]:='0';
for j:=1 to length(s) do if s[ j]>'0' then begin s:=copy(s,j,length(s)-j+1); break end;
j:=1; while(s[ j]='0')do begin s[j]:=' '; inc(j) end;
writeln; writeln(s); writeln;
for j:=9 downto 1 do begin for i:=1 to length(s) do if ord(s[ i])-48=j then write('*') else write(' '); writeln end;
for i:=1 to length(s) do write('*'); writeln; readln
end.