Найти максимальную и минимальную строку и поменять их местами

const
 SSS = 9; {Не больше 9 !!!}
 F: set of char = [' ',',','.',':',';','!','?']; {дополни, если надо}
var
 A: array[1..SSS] of string;
 S: string;
 Mi, Ma, Im, i: byte;
Begin
 Writeln('Вводите текст:');
 i:=0;
 Mi:=255;
 Ma:=0;
 Im:=0;
 repeat
  inc(i);
  if i>SSS then
   begin
    writeln('Максимум ',SSS,' строк! Ввод окончен.');
    S:='';
   end else
   begin
    Readln(S);
    A[i]:=S;
    if (length(S)>Ma) and (S<>'') then
     begin
      Ma:=length(S);
      Im:=(i*10)+(Im mod 10);
     end;
    if (Length(S)<Mi) and (S<>'') then
     begin
      Mi:=length(S);
      Im:=((Im div 10)*10)+i;
     end;
   end;
 until not (S<>'');
 S:=A[Im div 10];
 A[Im div 10]:=A[Im mod 10];
 A[Im mod 10]:=S;
 writeln('Максимальная и минимальная строки переставлены:');
 For i:=1 to SSS do
  if A[i]<>'' then Writeln(A[i]);
 writeln;
 writeln('Слова с заглавной буквы:');
 For i:=1 to SSS do
  For Im:=1 to length(A[i]) do
   if A[i][Im] in ['A'..'Z','А'..'Я'] then
    begin
     Mi:=Im;
     repeat
      write(A[i][Mi]);
      inc(Mi);
     until (A[i][Mi] in F);
     write(' ');
    end;
 Writeln;
 Readln;
End.