Упорядочить элементы столбцов матрицы по неубыванию, а сами столбцы по неубыванию характеристик строк

const
  rows = 5;
  cols = 8;
type
  column = array[1 .. rows] of integer;
  matrix = array[1 .. cols] of column;
 
  plain = array[1 .. rows * cols] of integer;
 
type
  TLessFunc = function(var X; i: integer; var Y; j: integer): boolean;
 
 
procedure HeapSort(Var arr; n: Integer;
          size: integer; fLess: TLessFunc);
var
  Left, Right: integer;
  x: plain;
  ar: plain absolute arr;
 
  procedure sift;
  var i, j: Integer;
  begin
    i := Left; j := 2*i;
 
    move(ar[pred(i)*size + 1], x[1], size*sizeof(integer));
 
    while j <= Right do begin
      if j < Right then
        if fLess(arr, j, arr, j + 1) then inc(j);
 
      if not fLess(x, 1, arr, j) then break;
      move(ar[pred(j)*size + 1], ar[pred(i)*size+1], size*sizeof(integer));
      i := j; j := 2 * i
    end;
 
    move(x[1], ar[pred(i)*size + 1], size*sizeof(integer));
  end;
 
var
  T: plain;
begin
  Left := Succ(n div 2); Right := n;
  while Left > 1 do begin
    Dec(Left); sift
  end;
 
  while Right > 1 do begin
    move(ar[pred(left)*size + 1], T[1], size*sizeof(integer));
    move(ar[pred(right)*size + 1], ar[pred(left)*size + 1], size*sizeof(integer));
    move(T[1], ar[pred(right)*size + 1], size*sizeof(integer));
 
    Dec(Right); sift
  end
end;
 
procedure print(const mx: matrix);
var
  i, j: integer;
begin
  for i := 1 to rows do begin
    for j := 1 to cols do
      write(mx[j, i]:4);
    writeln;
  end;
end;
 
{$f+}
function lessCol(var X; i: integer; var Y; j: integer): boolean;
var
  vX: matrix absolute X;
  vY: matrix absolute Y;
  k: integer;
  f1, f2: integer;
begin
  f1 := 0; f2 := 0;
  for k := 1 to rows do begin
    if (vX[i][k] > 0) and (vX[i][k] mod 2 = 0) then inc(f1, vX[i][k]);
    if (vY[j][k] > 0) and (vY[j][k] mod 2 = 0) then inc(f2, vY[j][k]);
  end;
  lessCol := f1 < f2;
end;
 
function lessInt(var X; i: integer; var Y; j: integer): boolean;
var
  vX: column absolute X;
  vY: column absolute Y;
begin
  lessInt := vX[i] < vY[j];
end;
{$f-}
 
var
  mx: matrix;
  i, j: integer;
begin
  for i := 1 to cols do
    for j := 1 to rows do
      mx[i, j] := random(30) - 5;
  writeln('до сортировки:');
  print(mx);
 
  { упорядочиваем элементы столбцов }
  for i := 1 to cols do begin
    heapSort(mx[i], rows, 1, lessInt);
  end;
 
  { теперь передвигаем столбцы }
  heapSort(mx, cols, rows, lessCol);
  writeln('после сортировки:');
  print(mx);
end.