[dr1nk]

Знаю что тема уже довольно таки не актуальна, но столкнулся со следующей проблемой. Есть лабиринт (массив). Допустим 100 на 100. Есть 2 точки: точка начала пути(А) и конечная точка(В). Необходимо найти кратчайший путь из точки А в точку В. Несколько исходников программ с интернете нашёл, но в моём случае передвигаться можно не только по вертикали или горизонтали, но и по диагонали. Есть у кого то есть исходник или какие либо наработки в этой сфере, могли бы поделиться? Заранее благодарен.

[dr1nk]

Вот нашёл некий пример лабиринта в интернете:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225

program TestLab;   uses Windows, ShellAPI;   const LabWidth = 100;       LabHeight = 100;   type TLabirint = array[1..LabHeight,1..LabWidth] of Integer;   var Lab: TLabirint;     BI, BJ, EI, EJ: Integer;     Path: string;   function IntToStr (A: Integer): string; // Перевод из числа в строку: begin   Str (A, Result); end; {function IntToStr}   function GetWay: string; // Поиск пути в лабиринте: const MinInit = -(LabWidth * LabHeight); var I, J, N: Integer;     Min: Integer;     Res: string;     procedure FindPath (I, J, Len: Integer);   // Рекурсивный поиск пути:   var DI, DJ: Integer;   begin     Dec (Len);     if (Len - Abs (EI - I) - Abs (EJ - J) > Min) and (Lab[I,J] <> 1) and        ((Lab[I,J] < Len) or (Lab[I,J] = 0)) then     begin       Lab[I,J] := Len;       if (I <> EI) or (J <> EJ) then       begin         DI := -1;         DJ := -1;         if J < EJ then DJ := 1;         if I < EI then DI := 1;         if I = EI then         begin           FindPath (I, J + DJ, Len);           FindPath (I + DI, J, Len);           FindPath (I, J - DJ, Len);           FindPath (I - DI, J, Len);         end else         begin           FindPath (I + DI, J, Len);           FindPath (I, J + DJ, Len);           FindPath (I - DI, J, Len);           FindPath (I, J - DJ, Len);         end; {if}       end else Min := Len;     end; {if}   end; {func FindPath}   begin   Min := MinInit;   FindPath (BI, BJ, 0);   Res := '';   I := EI;   J := EJ;   N := Lab[I,J];   if N <> 0 then   begin     while (I <> BI) or (J <> BJ) do     begin       Inc (N);       if Lab[I-1,J] = N then       begin         Res := Concat ('D', Res);         Dec (I);       end else       if Lab[I+1,J] = N then       begin         Res := Concat ('U', Res);         Inc (I);       end else       if Lab[I,J-1] = N then       begin         Res := Concat ('R', Res);         Dec (J);       end else       if Lab[I,J+1] = N then       begin         Res := Concat ('L', Res);         Inc (J);       end; {if}     end; {while}   end; {if}   Result := Res; end; {func GetWay}   procedure PrintLab; // Получение внешнего вида лабиринта: var I, J, P: Integer;     Steps: TLabirint;     S, Row, WH, TDClass: string;     F: Text; begin   for I := 1 to LabHeight do     for J := 1 to LabWidth do       Steps[I,J] := 0;   I := BI;   J := BJ;   for P := 1 to Length (Path) do   begin     case Path[P] of       'D': Inc (I);       'U': Dec (I);       'R': Inc (J);       'L': Dec (J);     end; {case}     Steps[I,J] := 1;   end; {for}   Assign (F, 'output.html');   Rewrite (F);   WriteLn (F, '<style type="text/css"><!--');   WriteLn (F, 'table.labirint');   WriteLn (F, '{');   WriteLn (F, ' border: 1px solid black;');   WriteLn (F, ' background-color: white;');   WriteLn (F, ' border-collapse: collapse;');   WriteLn (F, ' padding: 0px;');   WriteLn (F, ' font-size: 8pt;');   WriteLn (F, '}');   WriteLn (F, 'table.labirint td');   WriteLn (F, '{');   WriteLn (F, ' border: 1px solid black;');   WriteLn (F, ' background-color: white;');   WriteLn (F, ' text-align: center;');   WriteLn (F, ' text-decoration: none;');   WriteLn (F, ' font-weight: normal;');   WriteLn (F, ' padding: 0px;');   WriteLn (F, ' width: 12px;');   WriteLn (F, ' height: 12px;');   WriteLn (F, '}');   WriteLn (F, 'table.labirint th');   WriteLn (F, '{');   WriteLn (F, ' border: 1px solid black;');   WriteLn (F, ' background-color: #BF5000;');   WriteLn (F, ' text-align: center;');   WriteLn (F, ' text-decoration: none;');   WriteLn (F, ' font-weight: normal;');   WriteLn (F, ' padding: 0px;');   WriteLn (F, ' width: 12px;');   WriteLn (F, ' height: 12px;');   WriteLn (F, '}');   WriteLn (F, 'table.labirint td.path');   WriteLn (F, '{');   WriteLn (F, ' background-color: red;');   WriteLn (F, '}');   WriteLn (F, 'table.labirint td.step');   WriteLn (F, '{');   WriteLn (F, ' background-color: #EDFFEA;');   WriteLn (F, '}');   WriteLn (F, 'table.labirint td.begin');   WriteLn (F, '{');   WriteLn (F, ' background-color: green;');   WriteLn (F, '}');   WriteLn (F, 'table.labirint td.end');   WriteLn (F, '{');   WriteLn (F, ' background-color: lightblue;');   WriteLn (F, '}');   WriteLn (F, '--></style>');   WH := '';   S := '';   for I := 1 to LabHeight do   begin     Row := '';     for J := 1 to LabWidth do     begin       TDClass := '';       if Lab[I,J] < 0 then TDClass := ' class="step"';       if Steps[I,J] = 1 then TDClass := ' class="path"';       if (I = BI) and (J = BJ) then TDClass := ' class="begin"';       if (I = EI) and (J = EJ) then TDClass := ' class="end"';       if Lab[I,J] < 0 then Row := Concat (Row, '<td', WH, TDClass, '>', IntToStr (-Lab[I,J] - 1), '</td>');       if Lab[I,J] = 0 then Row := Concat (Row, '<td', WH, TDClass, '></td>');       if Lab[I,J] = 1 then Row := Concat (Row, '<th', WH, '></th>');     end; {for}     S := Concat (S, '<tr>', Row, '</tr>'#10);     WH := '';   end; {for}   S := Concat ('<table class="labirint">'#10, S, '</table>'#10);   WriteLn (F, S);   Close (F);   ShellExecute (0, 'open', 'output.html', nil, nil, SW_SHOW); end; {proc PrintLab}   procedure RandomLab; // Формирование случайного лабиринта: var I, J, N, D: Integer; begin   for I := 1 to LabHeight do   begin     Lab[I,1] := 1;     Lab[I,LabWidth] := 1;   end; {for}   for J := 1 to LabWidth do   begin     Lab[1,J] := 1;     Lab[LabHeight,J] := 1;   end; {for}   D := Random (3) + 2;   for N := 1 to LabWidth * LabHeight div D do     Lab[Random(LabHeight)+1,Random(LabWidth)+1] := 1;   repeat     BI := Random (LabHeight) + 1;     BJ := Random (LabWidth) + 1;   until Lab[BI,BJ] = 0;   repeat     EI := Random (LabHeight) + 1;     EJ := Random (LabWidth) + 1;   until Lab[EI,EJ] = 0; end; {proc RandomLab}   begin   Randomize;   RandomLab;   Path := GetWay;   PrintLab; end.

ТОлько в данном случае передвигается только по вертикали или горизонтали. Мне необходимо чтобы можно было двигаться и по диагонали. Подскажите что можно ли где то подправить данный код? Заранее спасибо