Дана последовательность из n элементов. Увеличьте ее, вставив после каждого максимального элемента минимальный.

Uses Crt;
const
     n=5;
     a:array [1..N] OF INTEGER =(1,2,3,5,5);
Var
   i,j,min,max,s:Integer;
Begin
     ClrScr;
     min:=a[1];
     max:=A[1];
     For i:=2 To n Do
     If min>a[i] Then min:=a[i]
     Else
     If max<a[i] Then max:=a[i];
     i:=1;
     while i<=n+1 do
     begin
           If A[i]=max Then
           begin
                for i:=n downto i  do
                a[i+1]:=a[i];
                a[I+1]:=min;
           end;
     s:=s+1;
     i:=i+1;
     end;
     for i:=1 to s+1 do
     WriteLn(A[i]);
     ReadKey;
End.

Скажите пожалуйста в чем ошибка... Когда меняются значения массива он начинает некорректрно исполнять программу. Help! Заранее спасибо!

const
  max_n = 5;

type
  TExtendArray = array [1..(max_n + pred(max_n))] of Integer;

var
  arr: TExtendArray;

  i, j, max, min, n: Integer;

begin
  writeln('Введите n, меньше ', max_n,': '); readln(n);

  for i := 1 to n do readln(arr[i]);

  max := arr[1]; min := arr[1];

  for i := 2 to n do
   if arr[i] > max then max := arr[i]
    else if arr[i] < min then min := arr[i];

  writeln('max = ', max);
  writeln('min = ', min);

  i := 1;

  while (i <= n) do
   if arr[i] = max then begin
     inc(n);
     for j := n downto i + 2 do
      arr[j] := arr[j - 1];
     arr[i + 1] := min;
     inc(i, 2);
   end else inc(i);

  writeln;

  for i := 1 to n do writeln(arr[i]);
end. 

klem4 спасибо! Выручил...