ЦИКЛ В ЦИКЛЕ Опции

[ipconnect]

Столкнулся с проблемой такого порядка. Как ни крутил, решить оптимально не получается. Требуется мозговой штурм коллективного разума. Задача выглядит следующим образом.

Имеется одномерный массив с N ячейками. Необходимо, казалось бы, просто сделать следующее. По заданному максимальному взятому для использования количеству ячеек M (<=N), начинающихся с первой от начала массива, необходимо менять значения в них следующим образом. Объяснить могу только на примере.
Т.е. в начале необходимо взять две первые ячейки. Изначально в первую записать 1, во вторую - на единицу больше. Затем надо менять значение во второй ячейке до некоторого числа K (к примеру, 30)...
Выглядит это так
1 2
1 3
...
1 30
Будут образовываться пары чисел, которые нужно потом будет сохранить. Но это уже к делу не относится. Тут бы сделать основное. Далее, когда значение во второй ячейке достигнет К, надо значение в первой ячейке увеличить на 1. И повторить цикл заново. Т.е.
2 3
2 4
...
2 30 и т.д. До того момента пока последняя пара будет К-1 К (в примере 29 30).
Далее необходимо включить в цикл третью ячейку. И сделать тот же самый цикл по тем же самым критериям изменений. Т.е. изначально это 1 2 3, потом 1 2 4 ... вплоть до К-2 К-1 К (28 29 30). Итак пока мы не заполним все три ячейки таким перебором. Потом четыре ячейки и т.д.
Перебор из M ячеек закончится тогда, когда последним набором чисел будет
K-M+1 K-M ... K-2 K-1 K

Думал, что просто. Справлюсь на раз-два-три. Оказалось не всё так просто, как кажется. Задача имеет практическое значение, поэтому бросить не могу. Нужно решить. Сам не в состоянии. Впервые попал в ступор при решении подобных задач. Помогите выбраться из тупика.

[ipconnect]

УРА!!! Сам докрутил
Вот, что получилось:

Program MH;
Const n=5; k=6;
Var a: array [0..n] of integer;
i,j,d,l,m: integer;
Id, Od: text;
begin
assign(Od,'C:\TP\tz.txt'); Rewrite(Od);
a[1]:=1; i:=1;
repeat
i:=i+1;
repeat
for j:=1 to k-a[i-1] do
begin
a[i]:=a[i-1]+j; d:=0;
for l:=1 to n do
if a[l]>a[l-1] then d:=d+1;
for l:=1 to n do
if d=i then write(Od,a[l]:3) else break;
if l=n then writeln(Od);
end;
a[i-1]:=a[i-1]+1;
m:=-1;
for l:=i-1 downto 1 do
begin
m:=m+1;
if a[l]>k-m then
begin
a[l-1]:=a[l-1]+1;
a[l]:=l;
end;
end;
until a[1]=k-i+2;
a[0]:=0;
for l:=1 to i do a[l]:=l;
until i=n;
close(Od);
end.