Задача с матрицами, Прошу помощи в решении. Опции

[jetman]

Проблема не дающая заснуть уже четвертый день:
Дана целая матрица размера nxm. Для каждой строки матрицы найти сумму четных элементов и произведение нечетных. Результаты оформить в виде матрицы (nx2). В полученной матрице упорядочить (переставить) строки по возрастанию второго элемента в строке.
Буду признателен за любую помощь.

Сообщение отредактировано: jetman - 18.10.2005 10:01

[jetman]

program test;

uses crt;

const

   n=5; {Должен ведь ограничивать максимальный размер матрицы,

   m=5; но почему то этого не делает}

type

  TVec = array[1 .. m] of integer;

  TArr = array[1 .. n] of TVec;

procedure InitArray(var x : TArr);

var i, j, m, n : byte;

begin

clrscr;

  repeat

   begin;

    write('Enter lines quantity, please: ');

    readln(n);

   end;

  until (n>0) and (n<=n);

  repeat

   begin

    write('Enter columns quantity, please: '); 

    readln(m)
 
end

  until (m>0) and (m<=m);

  for i := 1 to n do

    for j := 1 to m do

begin;      

write('x[', i, ',', j, '] = '); readln(x[i,j]);

end;

end;

procedure PrintArray(x : TArr ; sizeN, sizeM : byte);

var i, j : byte;

begin

  for i := 1 to sizeN do begin

    writeln;

    for j := 1 to sizeM do

      write(x[i,j]: 2, '  ');

  end;

  writeln;

end;

function Addition(x : TArr; i : byte) : integer;

var

  j : byte;

  S : integer;

begin

  s := 0;

  for j := 1 to m do

    if not odd(x[i, j]) then

      inc(s, x[i, j]);

  Addition := s;

end;

function Multiplication(x : TArr; i : byte) : integer;

var

  j : byte;

  p : integer;

begin

  p := 1;

  for j := 1 to m do

    if odd(x[i, j]) then

      p := p * x[i, j];

  Multiplication := p;

end;

procedure SortResult(var x : TArr);

var

  i: byte;

  flag: boolean;

  T: TVec;

begin

  flag := false;

  repeat

    flag := true;

    for i := 1 to n-1 do

      if x[i, 2] < x[succ(i), 2] then begin

        flag := false;

        T := x[i]; x[i] := x[succ(i)]; x[succ(i)] := T

      end;

   until flag;

end;

var

  arr, _result : TArr;

  t: byte;

Begin

  clrscr;

  InitArray(arr);

  PrintArray(arr, n, m);

  for t := 1 to n do begin

    _result[t, 1] := Addition(arr, t);

    _result[t, 2] := Multiplication(arr, t);

  end;

  writeln('Interval result');

  PrintArray(_result, n, 2);

  writeln('Final result');
  
  SortResult(_result);

  PrintArray(_result, n, 2);

writeln('Press enter for exit');  

readln;

End.

Получилось вот так, но есть одна проблема лишние нули (и как я понимаю неверный результат).