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

uses crt;
var s,sl,smin,smax,sn: string;
    i,imin,dmin,imax,dmax: integer;
begin
write('Введите строку: ');
readln(s);
s:=s+' '; sl:='';dmin:=length(s);dmax:=0;
for i:=1 to length(s) do
    if s[i]<>' ' then sl:=sl+s[i]
       else
       begin
       if (length(sl)<dmin) and (length(sl)<>0) then
          begin
          imin:=i-length(sl);
          dmin:=length(sl);
          smin:=sl;
          end;
       if length(sl)>dmax then
          begin
          imax:=i-length(sl);
          dmax:=length(sl);
          smax:=sl;
          end;
       sl:='';
       end;
writeln ('Самое короткое слово "',smin,'" длиной в ',dmin,' символов');
writeln ('Самое длинное слово "',smax,'" длиной в ',dmax,' символов');
if imax>imin then
   begin
   delete(s,imax,dmax);
   insert(smin,s,imax);
   delete(s,imin,dmin);
   insert(smax,s,imin);
   end else
   begin
   delete(s,imin,dmin);
   insert(smax,s,imin);
   delete(s,imax,dmax);
   insert(smin,s,imax);
   end;
writeln('Строка после обмена: ',s);
sl:=''; sn:='';
for i:=1 to length(s) do
    if s[i]<>' ' then sl:=sl+s[i] else
       if length(sl)>0 then
          begin
          if not (length(sl) mod 2=1) then
             sn:=sn+sl+' ';
          sl:='';
          end;
write('Строка после удаления слов нечетной длины: ',sn);
readkey
end.