Составить программу обмена местами максимума и минимума в массиве

Var a:array[1..1000] of integer;
N,max,max1,min,min1,i: integer;
begin
writeln('Введите количество элементов'); readln(N);
min:=32768; max:=-32768;
for i:=1 to N do begin
 readln(a[i]);
 if a[i]>max then begin max:=a[i]; max1:=i; end;
 if a[i]<min then begin min:=a[i]; min1:=i; end; 
end;
if (max<>-32769)and(min<>32768) then begin
 i:=a[max1]; a[max1]:=min; a[min1]:=i; end
else writeln('Обмен невозможен'); 
readln
end.

var a, b, c, i, n, max, min:integer;
    s :array [1..10000] of integer;
begin
   read (n);
   for i:=1 to n do
      read (s[i]);
   max:=s[1];
   min:=s[1];
   a:=1;
   b:=1;
   for i:=1 to n do
      begin
      if s[i]>=max then
          begin
         max:=s[i];
         a:=i;
         end;
      if s[i]<min then
         begin
         min:=s[i];
         b:=i;
         end;
      end;
   s[a]:=min;
   s[b]:=max;
   writeln;
   for i:=1 to n do
      write (s[i],' ');
end.