Несколько задач. Матрицы, процедуры, функции, работа с файлами

[d1mkaaa]

Здравствуйте. Проверьте пожалуйста задачку на матрицу. Вот условие:

Вычислить сумму и число элементов матрицы B[N,M], находящихся под главной диагональю и на ней.
n=2;m=2
Вот сама программа:

program P2;
const n=2;m=2;
var b:array [1..n,1..m] of integer;
i,j,k,sum,p,g,h:integer;
begin
writeln('Введите матрицу');
for i:=1 to n do
for j:=1 to m do
begin
write('b[',i,',',j,']->');
readln(b[i,j]);
end;
writeln ('Матрица');
for i:=1 to n do
begin
for j:=1 to m do
write(b[i,j]:3);
writeln;
end;
for i:=1 to n do
begin
for j:=1 to m do
if (i>=j) then
k:=k+b[i,j];
g:=g+1;
end;
writeln('Сумма', k);
writeln('Количество', g);
end.

Сумму элементов считает правильно, а вот число элементов считает не правильно. Помогите в чем ошибка.

Так же помогите решить следующие 3 задачи:

1)Решить задачу, используя процедуру с параметрами. В качестве исходных данных, принять матрицы A[N,M] и B[K,L] при N=<10, M=<5, K=<7, L=<6.
Для каждой из двух матриц сформировать одномерные массивы, в которых элементы равны колличествам положительных элементов в соответствующих столбцах.

2)Решить задачу, используя функцию пользователя. Даны 3 вектора X=(x1,...,xn), Y=(y1,...,yn), Z=(z1,...,zn). Упорядочить по возрастанию максимальные элементы этих векторов.

3)Составить программу создания файла, содержащего сведения об объектах для варианта задания. Программа должна обеспечить ввод исходных данных с клавиатуры, запись исходной информации в файл, чтение и печать созданного файла. Выполнить программу обработки файла.
Имя объекта: Студент;
Поля записи: ФИО студента, год рождения, группа, место рождения;
Задачи обработки:
Распечатать данные о студентах, родившихся в городе Владимире.

[mMAg]

if (i>=j) then
begin
k:=k+b[i,j];
g:=g+1;
end;

ибо писать нужно так...

[d1mkaaa]

Благодарю. Поможет кто с остальными задачами?

Вот решение этой задачи:

1)Решить задачу, используя процедуру с параметрами. В качестве исходных данных, принять матрицы A[N,M] и B[K,L] при N=<10, M=<5, K=<7, L=<6.
Для каждой из двух матриц сформировать одномерные массивы, в которых элементы равны колличествам положительных элементов в соответствующих столбцах.

program N7;
uses crt;
type mas1=array[1..10,1..6] of integer;
     mas2=array[1..10] of integer;
var i,j,h,n,m,k,l:integer;
    A:mas1;
    B:mas2;
procedure G(x:mas1;var y:mas2);
begin
 for i:=1 to n do
 begin
  y[i]:=0;
  for j:=1 to m do
  begin
   x[i,j]:=-10+random(20);
   write(x[i,j]:4);
   if x[i,j]>0 then
   y[i]:=y[i]+1;
  end;
  writeln;
 end;
end;
procedure t(y:mas2);
begin
 writeln;
 for I:=1 to n do
 write(y[i]:4);
end;
begin
 clrscr;
 randomize;
 writeln('Введите размерность матрицы A');
 writeln('a[n m] где n<=10 m<=5');
 readln(n,m);
 if (n<=10) and (n>0) and (m<=5) and (m>0) then
 begin
  writeln;
  G(a,b);
  t(b); writeln;
 end
 else begin writeln('Размер n или m не верен'); writeln; end;
 writeln('Введите размерность матрицы B');
 writeln('b[k l] где k<=7 l<=6');
 readln(n,m);
 if (n<=7) and (n>0) and (m<=6) and (m>0) then
 begin
  writeln;
  G(a,b);
  t(b); writeln;
 end
 else writeln('Размер k или l не верен');

End.

Проверьте правильность программы пожалуйста.

[Тимур(16rus)]

uses
  SysUtils,
  crt32;
type
  tree = record
  FIO : string[20];
  god : integer;
  grup : integer;
  mesto : string[20];
end;
  tvecr = array of tree;
  frec = file of tree;
var
  lst : tvecr;
  c : char;

procedure ShowMenu;
begin
  ClrScr;
  WriteLn(oem('1. Загрузить список из файла'));
  WriteLn(oem('2. Сохранить список в файле'));
  WriteLn(oem('3. Добавить данные в список'));
  WriteLn(oem('4. Создать новый список'));
  WriteLn(oem('5. Фильтр по списку'));
  WriteLn(oem('6. Показать весь список'));
  WriteLn(oem('0. Выход'));
end;

procedure LoadList(var list : tvecr);
var
  f : frec;
  fn : string;
  i : integer;
  count : integer;
begin
  WriteLn(Oem('Введите имя файла: '));
  ReadLn(fn);
  AssignFile(f, fn);
  {$I-}
  Reset(f);
  if IOResult <> 0 then
  begin
    WriteLn(Oem('Ошибка при открытии файла.' + 'Возможно неправильно указан путь к файлу'));
    WriteLn(Oem('Нажмите любую клавишу для возврата в меню...'));
    ReadKey;
    Exit;
  end;
     count := FileSize(f);
  SetLength(list, count);
  for i:=0 to count-1 do Read(f, list[i]);
  {$I+}
  CloseFile(f) ;
end;

procedure SaveList(list:tvecr);
var
  f : frec;
  fn : string;
  i : integer;
  ch : char;
  count : integer;
begin
  count:=length(list);
  if count = 0 then
  begin
    Write(Oem('Список пуст. ') ) ;
    WriteLn(Oem('Нажмите любую клавишу для возврата в меню...'));
    ReadKey;
    Exit;
  end;
  WriteLn(Oem('Введите имя файла: '));
  ReadLn(fn);
  AssignFile(f, fn);
  {$I-}
  // Обработка случая, когда указанный файл уже существует.
  if FileExists(fn) then
  begin
    WriteLn(Oem('Файл с таким именем уже существует.'));
    Write(Oem('Нажмите "Y" для перезаписи файла '));
    WriteLn(Oem('или "N" для возврата в меню.'));
    ch:=readkey;
    if LowerCase(ch) <> 'y' then Exit;
  end;
  Rewrite(f);
  if IOResult <> 0 then
  begin
    WriteLn(Oem('Ошибка при открытии файла.'));
    WriteLn(Oem('Нажмите любую клавишу для возврата в меню...'));
    ReadKey;
    Exit;
  end;
  for i:=0 to count-1 do Write(f, list[i]);
  {$I+}
  CloseFile(f) ;
end;
   // Процедура добавления одной новой записи в конец списка.
procedure InputRecord(var list:tvecr);
var count:integer;
begin
  WriteLn;
  count := length(list)+1;     // Увеличиваем на 1 длину массива.
  SetLength(list, count);
  with list[count-1] do
  begin
    Write(Oem('Введите ФИО : '));
    ReadLn(FIO);
    Write(Oem('Введите год рождения: '));
    ReadLn(god);
    Write(Oem('Введите № группы: '));
    ReadLn(grup);
    Write(Oem('Введите место рождения: '));
    ReadLn(mesto);
  end;
end;

procedure Add2List(var list:tvecr);
var ch:char;
begin
  repeat
    InputRecord(list);
    WriteLn(Oem('Для ввода следующей записи нажмите Enter.'));
    WriteLn(Oem('Для возврата в меню нажмите Esc...'));
    repeat
      ch := readkey;
    until (ch = #27) or (ch = #13);
  until ch = #27;
end;

procedure NewList(var list:tvecr);
var ch:char;
begin
  if length(list)<>0 then
  begin
    Write(Oem('При создании нового списка данные '));
    WriteLn(Oem('из прежнего списка будут утеряны.'));
    Write(Oem('Для продолжения нажмите Enter. '));
    WriteLn(Oem('Для возврата в меню нажмите Esc.'));
    repeat
      ch:=readkey;
    until (ch = #27) or (ch = #13);
    if ch = #27 then Exit;
  end;
  repeat
    InputRecord(list);
    WriteLn(Oem('Для ввода следующей записи нажмите Enter.'));
    WriteLn(Oem('Для возврата в меню нажмите Esc...'));
    repeat
      ch:=readkey;
    until (ch = #27) or (ch = #13);
  until ch = #27;
end;

[Тимур(16rus)]

procedure ShowList(list : tvecr);
var
  count:integer;
  i:integer;
begin
  count := length(list);
  if count = 0 then
  begin
    Write(Oem('Список пуст. '));
    WriteLn(Oem('Нажмите любую клавишу для возврата в меню...'));
    ReadKey;
    Exit;
  end;
TextColor(15);
  WriteLn(Oem('ФИО      Год рождения     Группа      Место рождения '));
  TextColor(7);
  for i:=0 to count-1 do
    with list [i] do
      WriteLn(Oem(FIO):9,' ',(god):3,' ',grup:7,' ',mesto:3);
  WriteLn;
  ReadKey;
end;

procedure FilterList(list:tvecr);
var
  count,i : integer;
begin
  count := length(list);
  if count = 0 then
  begin
    Write(Oem('Список пуст. '));
    WriteLn(Oem('Нажмите любую клавишу для возврата в меню...'));
    ReadKey;
    Exit;
  end;
  ClrScr;
  WriteLn(Oem('Студенты, проживающие во Владимире: '));
  WriteLn;
  TextColor(15);
WriteLn(Oem('ФИО      Год рождения     Группа      Место рождения '));
  TextColor(7);
  for i:=0 to count-1 do
    with list[i] do
    if (mesto = 'Vladimir') then
        WriteLn(Oem(FIO):9,' ',(god):3,' ',grup:7,' ',mesto:3);
  WriteLn;
  ReadKey;
end;

begin
  repeat
    ShowMenu;
    C:=Readkey;
    case c of
      '1':LoadList(lst);
      '2':SaveList(lst);
      '3':Add2List(lst);
      '4':NewList(lst);
      '5':FilterList(lst);
      '6':begin
            ClrScr;
            WriteLn(Oem('Исходный список:'));
            WriteLn;
            ShowList(lst);
          end;
end;
  until (c='0') or (c=#27);
end.

Проверь работу, вводи сведения англ буквами, задание про студентов, приму поощрение на телефон, +79520480884