Процедуры и функции Paskal

[Fromki]

Всем привет! Нужно написать программу на Паскале с использование процедуры и функции...

Вводится матрица MT (n,m) с цифровой информацией. Составить программу нахождения в столбцах матрицы положительных (>0) элементов, подсчета их количества и сумм. Получить новую матрицу, в которой элементы будут представлены числами, полученными от деления суммы положительных элементов по столбцу на значение конкретного элемента. Исходные, промежуточные и результатные данные вывести на дисплей.

Вот рабочий код с оформлением,но,повторюсь, нужно через процедуру и функцию....

program lab4;
uses  crt;
Label
   L1,L2;
var
A : array [1..10,1..10] of integer;
j : array [1..10,1..10] of integer;
B:array [1..10,1..10] of  real;
ch:char;
x, y, q, error:integer;
begin
clrscr;
   window(3,4,70,14);
    writeln ('Вашему вниманию представляется программа');
    writeln ('которая находит в столбцах матрицы положительные >0 элементы,');
    writeln ('подсчета их количества и сумм.);
    writeln ('Затем получает новую матрицу, в которой элементы’);
    writeln ('будут представлены числами, полученные от деления ');
    writeln ('положительных элементов по столбцу на значение конкретного элемента.');
    writeln ('Требования:');
    writeln ('Элементы матрицы должны быть целыми числами!');
    writeln ('Размерность матрицы должна быть не меньше двух,');
    writeln ('но и не более ста элементов');
    window (42,15,75,23);
    writeln (‘Программу составил студент’);
    writeln ('группы ***********');
    window (1,1,75,25);
    gotoxy(20,24);
    writeln ('для продолжении нажмите любую клавишу ');
    Ch:=readkey;
    L1:Clrscr;
repeat
    write('Введите размерность матрицы: ');
    {$I-}
    readln(q);
    error:=IOResult;
    {$I+}
    If(error<>0) or (q>100) or (q<2) then
    writeln('Ошибка ввода размерности’);
    until(error=0) and (q<=100) and (q>=2);
    writeln('Введите матрицу:',q,' столбца(ов) и ',q,' строк(и)');

for y:=1 to q do
begin
for x:=1 to q do
 begin
{$I-}
repeat
 read (A[y,x]);
         error:=ioresult;
         {$I+}
         If ( A[y,x] > 99) or (A[y,x] < -99) or (Error <> 0)  then
          writeln('ошибка ввода элемента матрицы’);
      until ( A[y,x] <=99) and ((A[y,x] >=-99) and (Error = 0));
     Readln;
     end;
     end;
     clrscr;
   writeln(‘Исходная матрица’);
     y:=0;
   while y < q do
    begin
       x:=1;
       j[y+1,1]:=0;
       j[y+1,2]:=0;
      repeat
     if A[y+1,x]>0 then
        begin
     j[y+1,1]:=j[y+1,1]+ A[y+1,x];
     j[Y+1,2]:=  j[Y+1,2]+1;
        end;
      inc(x);
      until x>q;
     y:=y+1;
    end;
    writeln('');
   y:=1;
   repeat
     for x:=1 to q do
       begin
   if  (y=1)  then
        write('_____')
       else
   if  (y>q+1)  then
        write('-----')
         else
        begin
           if A[x,y-1] > -1 then
                write(' ');
        write(A[x,y-1]);
        write(' | ');
         end;
        end;
       writeln;
       inc(y,1);
    until (q+2<y);

    for x:=1 to q do
      begin
      write(' ');
 write(j[x,1]:1:0);
        write(' | ');
      end;
 writeln(' сумма элементов >0');
     for x:=1 to q do
      begin
   write(' ');
 write(j[x,2]:1:0);
        write(' | ');
      end;
 writeln(' количество элементов >0');

for x:=1 to q do
for y:=1 to q do
if A[x,y]<>0 then
B[x,y]:= j[x,1] div A[x,y];
 writeln;

   writeln(‘Полученная матрица’);
   x:=0;
   repeat
     inc(x,1);
     for y:=1 to q do
     begin
       if  (x=1)  then
         write('_____')
         else
   if  (x>q+1)  then
        write('-----')
         else
        begin
     if B[y,x-1] > -1 then
                write(' ');
     write(B[y,x-1]:1:1);
     write(' | ');
        end;
     end;
     writeln;
   until q<(x-1);
begin
  writeln;
  writeln('Хотите повторить? <Y/N)');
       L2:
           Case Readkey of
           #89: Goto L1;
           #121: Goto L1;
           #78: Exit;
           #110: Exit;
       End;
       Goto L2;
readln;
readln;
end;
end.

[BeerDrinker]

Суть ввода процедур и функций в данную программу сводится к вынесению логических отдельных блоков в эти самые процедуры или функции, к примеру так можно оформить создание массива, вывод его на экран, подсчет суммы максимальных элементов (функция) и далее по тексту.
Часть вашего кода я опустил, пометил соответствующими комментариями

program lab4;
uses  crt;
Type 
MyArray=array [1..10,1..10] of  real; {пришлось прибегнуть к такой конструкции для унификации вывода}
var
A,B :MyArray;
j : array [1..10,1..2] of integer;

ch:char;
x, y, q, error:integer;

procedure Intro; {Сделал как пример, выносить этот блок в процедуру не обязательно, поскольку вывод этих данных используется только один раз}
 begin
 clrscr;
  {Здесь много вашего текста с условиями задачи и информации о студенте и проч.}
    Ch:=readkey;
   end;

procedure CreateArray_A(N:byte);  {Процедура создает массив А}
{var
 x,y:byte;  вообще в идеале для использования переменных-счетчиков в цикле подпрограммы используют локальные переменные, не стал менять чтобы не запутать вас} 
begin
for y:=1 to N do
begin
 for x:=1 to N do
   begin
    {$I-}
    repeat
      read (A[y,x]);
      error:=ioresult;
     {$I+}
      If ( A[y,x] > 99) or (A[y,x] < -99) or (Error <> 0)  then
        writeln('ошибка ввода элемента матрицы’);
    until ( A[y,x] <=99) and ((A[y,x] >=-99) and (Error = 0));
    Readln;
    end;
  end;
end;

procedure CreateArray_J(n:byte); {Процедура создает массив J}
begin
   y:=0;
   while y < n do
    begin
       x:=1;
       j[y+1,1]:=0;
       j[y+1,2]:=0;
      repeat
     if A[y+1,x]>0 then
        begin
     j[y+1,1]:=j[y+1,1]+ A[y+1,x];
     j[Y+1,2]:=  j[Y+1,2]+1;
        end;
      inc(x);
      until x>n;
     y:=y+1;
    end;
end;

{Процедура Выводит на печать массив Arr размерностью n и если флаг formatted установлен в true - с форматирвоанием для вещественных чисел, иначе для целых}
procedure WriteArray(var Arr:MyArray; n:byte; Formatted:boolean);
var x,y:byte;
begin
 writeln('');
  y:=1;
   repeat
     for x:=1 to n do
       begin
   if  (y=1)  then
        write('_____')
       else
   if  (y>n+1)  then
        write('-----')
         else
        begin
           if Arr[x,y-1] > -1 then
                write(' ');
       if formatted then write(Arr[x,y-1]:1:1) else write(Arr[x,y-1]:1:0);
        write(' | ');
         end;
        end;
       writeln;
       inc(y,1);
    until (n+2<y);
end; 

begin
 Intro; {Ну вот она наша первая процедура} 

{L1:Clrscr; Ужасная конструкция...Нам в институте за такое били по рукам железными линейками ))) эту вещь мы заменим бесконечным циклом} 

repeat

Clrscr;
    {Ввод размерности матрицы}

CreateArray_A(q); {создаем массив с заданным параметром q}

     clrscr;
   writeln(‘Исходная матрица’);
  CreateArray_J(q); {Создаем исходную матрицу сумм}
writearray(a,q,false);{выводим массив целых чисел (без форматирования)}
    
{Вывод количества элементов больше и нуля табличкой, опять же опустил часть кода}

{Тут был ваш код по нахождению новой матрицы}

   writeln(‘Полученная матрица’);
     writearray(b,q,true);{выводим массив вещественных чисел (с форматированием)}
     

  writeln;
  writeln('Хотите повторить? <Y/N)');

{Читаем клавишу до появления Y либо при появлении N завершае\м программу}
repeat
ch:=Readkey;
if (ch=#78)  or (ch=#110) then Exit;
until (ch=#89)or(ch=#121)

until false; {бесконечный цикл, выйти из которого можно только по условию выше}
end.

Долго ломал голову как сюда функцию приплести, но так и не придумал, тем не менее, думаю общий смысл понятен и при соответствующем желании функцию все таки можно куда-нибудь ввернуть
Будут вопросы по принципу построения функций и процедур - обращайтесь. Еще раз напомню что данный пример не является решением, а лишь демонстрирует подход, проверяйте внимательно программу, вцелом логика должна быть правильной.

[Fromki]

procedure CreateArray_J(n:byte); {Процедура создает массив J}
begin
   y:=0;
   while y < n do
    begin
       x:=1;
       j[y+1,1]:=0;
       j[y+1,2]:=0;
      repeat
     if A[y+1,x]>0 then
        begin
     j[y+1,1]:=j[y+1,1]+ A[y+1,x]; {выдает ошибку 26 для Х}
     j[Y+1,2]:=  j[Y+1,2]+1;
        end;
      inc(x);
      until x>n;
     y:=y+1;
    end;
end;

[BeerDrinker]

Сообщение от Fromki

{выдает ошибку 26 для Х}

а можно поподробнее?
тестировал на данных
1 -3 1
2 -3 1
-1 -3 1
все нормально

[Fromki]

ну как поподробней, при запуске программы курсор ставится на ту строку и появляется ошибка 26, я сам не могу разобраться что нужно сделать,чтобы ее исправить

[BeerDrinker]

попробуй заменить ту строку на

 j[y+1,1]:=round (j[y+1,1]+ A[y+1,x]);

[Fromki]

Спасибо, все работает!