type
mas = array[1..m, 1..n] of integer;

var
a, path: mas; {path - puti ko vsem maximumam b[1..n]}
i, j, k,
t, max, s: integer;
b: array[1..n] of integer; {massiv summ maximumov po strokam}

begin
clrscr;
randomize;
{sozdadim massiv}
for i := 1 to m do
for j := 1 to n do
begin
a[i,j] := random(20);
GotoXY(j * 5, i);
write(a[i, j]);
end;
writeln;

{sostavim reshenie postavlenoi zadachi}
for i := 1 to n do {zapolnyaem pervuyu stroku puti prohozhdeniya komnaty}
path[1, i] := i;

for j := 1 to n do {idem ot kazhdogo elementa pervoi stroki}
begin
s := a[1, j];
t := j; {zapominaem predidushie koordinaty po osi X}

for i := 1 to m - 1 do
begin
max := 0;

for k := t - 1 to t + 1 do
begin
if (k = 0) or (k = n + 1) then continue; {propuskaem zapredely}
if a[i + 1, k] > max then {ishem maximum v stroke po dopustimim usloviyam dvizheniya: Z, ZW, ZE}
begin
max := a[i + 1, k];
t := k;
end;
end;
path[i + 1, j] := t;
s := s + max;
{writeln('j= ', j, '; ', i, '# max inline = ', max, '; s= ', s);
readkey;} {statistika, }
end;
{writeln;}
b[j] := s; {zapominaem vse maximumy v resul'tate prohozhdeniya ot kazdogo nachala}
end;

(*for i := 1 to m do {vivodim matricu putei, gde put' idet naprotyazhenii vsego}
begin {stolbca, v koord X matrici komnaty}
writeln;
for j := 1 to n do
write(path[i, j]:5);
end;*) {mozhno i ne nado :-) }

max := 0;
for j := 1 to n do
if b[j] > max then
begin
max := b[j];
t := j;
end;

writeln(#10#13, 'Max = ', max);
write('Path = ');
for i := 1 to m do
write(' ', path[i, t]);

readkey;
end.

Источник: