Var
 N:Word;
 i,k,Imax,Imin:Byte;
 C:Array[1..4] of Byte;
Begin
 Repeat
  Write('N= ');
  Readln(N);
  If (N<1000) or (N>9999) then Writeln('Incorrect!');
 Until (N>999) and (N<10000);
 For i:=4 downto 1 do
  begin
   C[i]:=N mod 10;
   N:=N div 10;
  end;
 Imax:=1;
 Imin:=1;
 For i:=1 to 4 do
  begin
   if C[i]>C[Imax] then Imax:=i;
   if C[i]<C[Imin] then Imin:=i;
  end;
 k:=C[Imin];
 C[Imin]:=C[Imax];
 C[Imax]:=k;
 For i:=1 to 4 do write(C[i]);
 Readln
End.

Program Integer1;
var
L:Integer;
lC: array [1..4] of integer;
i,min,max:Integer;
begin
Writeln('Введите четырёх значное число L=');
readln(L);
if (L>9999)or(L<1000) then Writeln('Это не четырёх значное число ')
else begin
min:=1;
max:=1;
for i:=1 to 4 do  begin
  LC[i]:=l mod 10;
  L:=L div 10;
if LC[i]>LC[max] then max:=i;
if LC[i]<LC[min] then min:=i;
end;
L:=LC[max];
LC[max]:=LC[min];
LC[min]:=L;
L:=LC[4]*1000+LC[3]*100+LC[2]*10+LC[1];
Writeln(L);
  end;
end.

А насчет возможного нуля в спереди. 
Так трехзначное число тоже число. 
Как вариант ответа думаю допустим. 

Поменять местами наибольшую и наименьшую цифры
От сюда додумал вывести как одно число.

Antonioband пусть выбирает.

А с циклом выглядит человечнее.