Поменять местами столбец с наибольшим значением со столбцом с наименьшим значением

var
  A: array [0..2, 0..2] of integer;
  i, j, V, maxj, minj, max, min: integer;
 
begin
  for i := 0 to 2 do 
    for j := 0 to 2 do
    begin
      write('A[', i, ',', j, ']= ');
      readln(A[i, j]);
    end;
  
  max := A[0, 0];
  min := A[0, 0];
  minj := 0;
  maxj := 0;
  
  for i := 0 to 2 do 
    for j := 0 to 2 do
    begin
      if (A[i, j] > max) then begin
        max := A[i, j];
        maxj := j;
      end;
      if (A[i, j] < min) then begin
        min := A[i, j];
        minj := j;
      end;
    end;
    
  for i := 0 to 2 do 
  begin
    for j := 0 to 2 do
      write(A[i, j]:4);
    writeln
  end;
  
  for i := 0 to 2 do
    for j := 0 to 2 do
    begin
      if maxj = minj then break;
      V := A[i, maxj];
      A[i, maxj] := A[i, minj];
      A[i, minj] := V;
    end;
  
  writeln;  
  
  for i := 0 to 2 do 
  begin
    if maxj = minj then begin
      Writeln('Максимальный и минимальный элементы находятся в одном столбце.');
      break;
    end;
    for j := 0 to 2 do
      write(A[i, j]:4);
    writeln
  end;
  
end.