Program ALGORITM_FLOYDA;
Uses CRT;
Const
        n = 5;
Var
        a, m: Array[1..n,1..n] of Integer;
        i, j, k: Integer;
        ch: Char;
        t1, t2: Integer;

Procedure Reqrs(x1, x2: Byte); {2, 1}
Var l: Byte;
Begin
l := m[x1, x2];
If (l <> x2) then Write(' <- ',l)
             else Reqrs(x1, m[x1, l]);
If (l <> x1) then Write(' <- ',x1);
End;

Function min: Integer;
Var summ: Integer;
Begin
If (a[i,k] = -1) or (a[k,j] = -1) then summ := -1
                                  Else summ := a[i,k] + a[k,j];
If ((a[i,j] > summ) or (a[i,j] = -1)) and (summ <> -1) then
   m[i,j] := m[k,j];
If (summ = -1) then Begin min := a[i,j]; Exit; End
Else
   Begin
   If (a[i,j] = -1) then Begin min := summ; Exit; End
   Else Begin
        If (a[i,j] < summ) then Begin min := a[i,j]; Exit; End
                           Else Begin min := summ; Exit; End;
        End;
   End;
End;

Procedure Print;
Var ii, jj: Integer;
Begin
For ii := 1 to n do
    For jj := 1 to n do
        Begin
        GotoXY(jj*4, ii);
        Write(a[ii,jj]);
        GoToXY(jj*4 + 20,ii);
        Write(m[ii,jj]);
        End;
End;

Begin
ClrScr;
{СОЗДАНИЕ МАССИВОВ}
For i := 1 to n do
    Begin
    Write(i,'-ый ряд: ');
    For j := 1 to n do
        Begin
        Read(a[i,j]);
        m[i,j] := i;
        End;
    Writeln;
    End;
For k := 1 to n do
    Begin
    ClrScr;
    For i := 1 to n do
        Begin
        For j := 1 to n do
            Begin
            If (i = j) then Continue; {Обход диагонали}
            a[i,j] := min;
            End;
        End;
    Print;
    Writeln(#13#10,'Шаг: ',k);
    ReadKey;
    End;
Repeat
Writeln('[RET] || [ESC]');
Case ReadKey of
#13: Begin
     Write('Из какой точки: '); Readln(t1);
     Write('В какую точку : '); Readln(t2);
     Write(#13#10,'Стоимость: ',a[t1, t2],#13#10,t2);
     Reqrs(t1, t2);
     Write(#13#10#13#10);
     End;
#27: Halt(0);
End;
Until False;
End.

Источник: