Поменять местами значение первого четного элемента массива со значением последнего нечетного элемента массива.

const
  n = 30;
type
  TArr = array[1..n] of integer;
var
  arr: TArr;
  index: byte;
 
procedure FormMass(var arr: TArr);
var
  i: byte;
begin
  randomize;
  for i:=1 to n do
    arr[i]:=random(30);
end;
 
procedure Obmen(var arr: TArr; var index: byte);
var
  buf, i: byte;
begin
  for i:=1 to n do
    if odd(arr[i]) then index:=i;
  buf:=arr[index];
  arr[index]:=arr[1];
  arr[1]:=buf;
end;
 
procedure WriteMass(arr: TArr);
var
  i: byte;
begin
  writeln('Массив: ');
  for i:=1 to n do
    write(arr[i], ' ');
  writeln;
end;
 
begin
  FormMass(arr);
  WriteMass(arr);
  Obmen(arr, index);
  WriteMass(arr);
end.

program project1;
 
uses crt;
 
const
  nMax = 30;
 
var
  c: array [1..nMax] of integer;
  i,ich,inch,tmp: integer;
 
procedure forming;  {заполнение и вывод массива}
begin
  randomize;
  textcolor(lightgreen);
  write('Исходный массив: ');
  for i:=1 to nMax do
    begin
      c[i]:=random(50)+1;
      write(c[i],' ');
    end;
  writeln;
end;
 
procedure search;   {поиск первого четного и последнего нечетного}
begin
    textcolor(white);
  for i:=1 to nMax do
    if not odd(c[i]) then
      begin
        ich:=i;
        writeln('c[',ich,'] = ',c[ich],' - первый четный элемент');
        break;
      end;
  for i:=nMax downto 1 do
    if odd(c[i]) then
      begin
        inch:=i;
        writeln('c[',inch,'] = ',c[inch],' - последний нечетный элемент');
        break;
      end;
end;
 
procedure exchange;     {обмен элементов местами}
begin
  tmp:=c[ich];
  c[ich]:=c[inch];
  c[inch]:=tmp;
end;
 
procedure output;       {вывод измененного массива}
begin
  textcolor(lightgreen);
  write('Измененный массив: ');
  for i:=1 to nMax do write(c[i],' ');
  readln;
end;
 
begin                   {тело основной программы}
  forming;
  search;
  exchange;
  output;
end.

procedure Obmen(var arr:TArr);
var
  i,buf,i1,i2:integer;
begin
  for i:=1 to n do
    begin
      if odd(arr[i]) then i2:=i;
      if not odd(arr[n-i+1]) then i1:=n-i+1;
      (*Тут еще проверку по-хорошему надо сделать, 
      есть ли вообще четные или нечетные, иначе результаты будут
      плачевные*)
    end;
    buf:=arr[i1];
    arr[i1]:=arr[i2];
    arr[i2]:=buf;    
end;