Поменять местами в предложении самое длинное и самое короткое слово.

var i,l,min,max,p1,p2,j:longint;a,b:string;
    t:array[1..60]of string;
    f:array[1..60]of longint;
begin
   write('введите строку : ');readln(a);
   l:=length(a)+1;a[l]:=' ';
   for i:=1 to l do
   if a[i]=' ' then begin
   inc(j);t[j]:=b;
   f[j]:=length(b);b:=''        end  else b:=b+a[i];
    max:=f[1];min:=f[1];p1:=1;p2:=1;
   for i:=1 to j do
    begin
     if max<f[i] then begin max:=f[i];p1:=i; end;
     if min>f[i] then begin min:=f[i];p2:=i; end; end;
   writeln('самое длинное слово: ',t[p1]);
   writeln('самое короткое слово: ',t[p2]);
end.

uses crt;
var s,s1,s2:string;
    sk,sd:string;
    len,k,d,i,ik,id:byte;
begin
clrscr;
writeln('Введите строку из слов, отделенных пробелами:');
readln(s);
s1:=s+' ';
while pos('  ',s1)>0 do
delete(s1,pos('  ',s1),1);
if s1[1]=' 'then delete(s1,1,1);
sd:='';sk:='';{длинное и короткое слова}
d:=0;k:=255;{их начальная длина}
ik:=1;id:=1;{индекс их начала в строке}
while pos(' ',s1)>0 do
 begin
  len:=pos(' ',s1)-1;
  s2:=copy(s1,1,len);
  if len<k then
   begin
    sk:=s2;{запоминаем кроткое слово}
    k:=len;
    ik:=pos(sk,s);{где оно начинается}
   end;
  if len>d then
   begin
    sd:=s2;{тоже с длинным}
    d:=len;
    id:=pos(sd,s);
   end;
  delete(s1,1,pos(' ',s1));
 end;
writeln('Самое короткое слово ',sk);
writeln('Самое длинное слово ',sd);
if ik<id then{если короткое раньше длинного}
 begin
  insert(sk,s,id);{вставляем короткое перед длинным}
  delete(s,id+k,d);{удаляем длинное}
  insert(sd,s,ik);{вставляем длинное перед коротким где оно было}
  delete(s,ik+d,k);{удаляем короткое}
 end
else{если длинное раньше, тоже, но наоборот}
 begin
  insert(sd,s,ik);
  delete(s,ik+d,k);
  insert(sk,s,id);
  delete(s,id+k,d);
 end;
write(s);
readln
end.