че то поздно я сел эту фиговину писать. потестите сами - работает\не работает?
блок схема всей программы нужна??? это фигня. её долго рисовать. если только саму реализацию алгоритма...

uses crt;
const
  TownCount = 10;
  MaxCost   = 100;
var
  CurCost : Integer; {current cost}
  MinCost : Integer; {Minimal cost for step from current city}
  r : array[1..TownCount,1..TownCount] of Integer;
  Way : array[1..TownCount*TownCount] of Integer;
  WayCount : Integer;
  CurTown : Integer; {current city}
  NextTown : Integer;
  FilledTable : Boolean;
  Answer : Char;
  i,j : Integer;
  istr,jstr : string;
  st : string;
  LastTown : Integer;
begin
  clrscr;
  randomize;
  {fill table}
  FilledTable := false;
  repeat
    Writeln('Fill table with random? Y\N');
    Readln(Answer);
    if (upcase(Answer) = 'Y') or (upcase(Answer) = 'N') then
      FilledTable := true;
    if FilledTable then
    begin
      for i := 1 to TownCount do
        for j := 1 to i do
          if i = j then
            r[i,j] := -1
          else
          begin
            if upcase(Answer) = 'Y' then
                 r[i,j] := 1 + Random(MaxCost)
            else
            begin
              str(i,istr);
              str(j,jstr);
              Writeln('Cost from '+istr+' to '+jstr+': ');
              repeat
                read( r[i,j] );
              until ( r[i,j] > 0)and( r[i,j] <= MaxCost );
            end;
            r[j,i] := r[i,j];
          end;
    end;
  until FilledTable;

  {show table}
  Writeln('Cost table:');
  Write( '  ' );
  for j := 1 to TownCount do
    Write( j:4 );
  for i := 1 to TownCount do
  begin
    writeln;
    write(i:2);
    for j := 1 to TownCount do
      Write( r[i,j]:4 );
  end;

  {calculate way from first to last town}
  WayCount := 0;
  CurTown := 1;
  LastTown := TownCount;
  CurCost := 0;
  while ( CurTown <> LastTown) do
  begin
    MinCost := MaxCost + 1;
    NextTown := 0;
    for i := 1 to TownCount do
      if ( r[i,CurTown] < MinCost) and ( r[i,CurTown]<> -1 ) then
      begin
        NextTown := i;
        MinCost := r[i,CurTown];
      end;

    inc(WayCount);
    Way[WayCount] := NextTown;
    r[CurTown , NextTown] := -1;
    r[NextTown , CurTown] := -1;
    CurTown := NextTown;
    inc(CurCost,MinCost);
  end;

  {Print results}
  Writeln;
  str(CurCost,st);
  Writeln('Total cost:' + st);
  str(WayCount,st);
  Writeln('Total step count:' + st);
  Writeln('Way:');
  for i := 1 to WayCount do
    Write(Way[i],',');
end.

ндя...

девушка сдала?