uses WinCrt, My_ZS;
var i, j, minimum, maximum, r, minX, maxX: integer;{индексы элеметов, где i-сттрока, j-столбец}
k, m, n, w: integer;
name: string;
A: mas2r_i; {2мерный массив}
x: mas1r_x;{сформированный 1мерный массив}
f: boolean;
procedure mas_x( n: integer; var x: mas1r_x);
var s: word;
begin writeln; writeln('массив, сформиpованный из сумм положительных элементов строк исходного массива');
n:=1;
for i:=1 to m do
begin S:=0;
for j:=1 to k do
begin
if a[i,j]>0 then
S:=S+a[i,j];
end;
x[n]:=s; writeln(' x[',n,']=',s:3);
n:=n+1;
end; writeln;
end;
Procedure MxL(n:integer; x:mas1r_x);
var max:integer;
begin
max:=x[1];
for i:=1 to n do
begin
if x[i]>max then
max:=x[i];
writeln('максимальный элемент равен',max);
end;
end;
Procedure MnL(n:integer; x:mas1r_x);
var min:integer;
begin
min:=x[1];
for i:=1 to n do
begin
if x[i]<min then
min:=x[i];
writeln('максимальный элемент равен',min);
end;
end;
Procedure Zadanie;
begin
writeln(' И С Х О Д Н Ы Е Д А Н Н Ы Е');
Writeln('Прямоугольная целочисленная матрица С, состаящая из');
Writeln('М строк по К элементов');
Writeln(' З А Д А Н И Е');
Writeln('Сформировать массив Х из сумм положительных элементов');
Writeln('строк матрицы С; В массиве Х найти максимальный и минимальный элементы');
end;
BEGIN
zastavka(5,'Массивы'); ClrScr;
Zadanie;
writeln;
writeln;
vvod_mas2r(max,'A', m, k, A);{ввод 2мерного масссива}
vivod_mas2r(m, k, 'A', a);readln;
mas_x(n, x);readln;
MxL(n,x);
MnL(n,x);
povtorka(f);
end.
мой Модуль
interface
Uses winCrt, windos;
const max=50;
type mas1r_x=array[1..max] of integer;{тип 1мерного массива целочисленного типа}
mas1r_i=array[1..max] of string[50];{тип 1мерного массива целочисленного типа}
mas2r_i=array[1..max,1..max] of integer;{тип 2мерного массива целочисленного типа}
mas2r_r=array[1..max,1..max] of real; {тип 2мерного массива вещественного типа}
var i, j: integer;{индексы элеметов, где i-сттрока, j-столбец}
procedure vvod_mas2r(max: byte; name: string;var m, k: integer;
var a: mas2r_i);{ввод 2мерного масссива}
procedure vvod_mas1r(max: byte; name: string; var m: integer;
var x: mas1r_x);{ввод 2мерного масссива}
procedure vivod_mas2r(m,k: integer; name: string;a: mas2r_i);
procedure vivod_1r(n:integer; name:string; x:mas1r_x);
procedure In_Real(g:char; var x:real);
procedure Out_real(g: char;var a: real);
Procedure WaitDos (WaitTime :word);
procedure In_integer(g: char; var a: integer);
procedure wait;
procedure In_real_comment(g: string; var a: real);
procedure chetnost ( var a: integer);
procedure In_integer_comment(g: string; var a: integer);
procedure Out_real_comment(g: string; var a: real);
procedure Out_integer_comment(g: string; var a: integer);
procedure povtor(var f: boolean);
procedure povtorka(var f: boolean);
implementation
procedure vvod_mas2r(max: byte;name: string; var m, k: integer;
var a: mas2r_i);
label L;
var f: boolean;
begin
repeat
writeln('введите количество строк массива ',name,'< ',max);
readln(m);
writeln('введите количество столбцов массива ',name,'< ',max);
readln(k);
f:=((m>=0)and(m<max))and((k>=0)and(k<max));
if not f then
writeln('Вы ошиблись. Максимальное кол-во строк ',max,
' Максимальное кол-во столбцов ',max);
until f;
for i:=1 to m do
begin
for j:=1 to k do
begin {$I-}
L: write (name,'[', i:2,',',j:2,']=');
read(a[i,j]); {$I+}
if IOResult<>0 then begin
writeln('вы ошиблись, повторите ввод'); goto L; end; end; writeln;
end;
end;
procedure vvod_mas1r(max: byte;name: string; var m: integer;
var x: mas1r_x);
label L;
var f: boolean;
begin
ClrScr;
repeat
writeln('введите количество строк массива ',name,'< ',max);
readln(m);
f:=((m>=0)and(m<max));
if not f then
writeln('Вы ошиблись. Максимальное кол-во строк ',max);
until f;
for i:=1 to m do
begin
{$I-}
L: write (name,'[', i:2,']=');
read(x[i]); {$I+}
if IOResult<>0 then begin
writeln('вы ошиблись, повторите ввод'); goto L; end; end; writeln;
end;
procedure vivod_mas2r(m,k: integer; name: string;a: mas2r_i);
begin
for i:=1 to m do
begin
for j:=1 to k do
begin
write(' ',name,'[',i:2,',',j:2,']=', a[i,j]:3);
end;
writeln; end; readln;
end;
procedure vivod_1r(n:integer; name:string; x: mas1r_x);
var i:integer;
begin
for i:=1 to n do write (' ',name,'[',i:2,']=',x[i]:3);
writeln;
end;
{ввод переменной вщественного типа}
PROCEDURE In_Real;
Label 1;
BEGIN
1: Write('Введите значение ',g,'='); {$I-} Readln(x) {$I+};
If Ioresult<>0 then
BEGIN
Writeln('Неверный ввод! повторите! ');
Goto 1
END;
end;
procedure Out_real(g: char;var a: real);
begin
write(g,'= ', a:8:6);
end;
Procedure WaitDos;
VAR House, Minute, Second, Sec100, Second_0:word;
Begin
GetTime(House, Minute, Second, Sec100);
if WaitTime+Second >= 60 then Second_0:= WaitTime + Second-60
else Second_0:= Second + WaitTime;
repeat GetTime(House, Minute, Second, Sec100);
until Second = Second_0;
END;
{ввод целочисленной переменной}
procedure In_integer(g: char; var a: integer); label 1;
begin {$I-}
1: write ('введите значение ',g,' '); read (a); {$I+}
if IOResult <>0 then begin writeln('Вы ошиблись повторите ввод');goto 1; end
else
end;
procedure wait;
begin
write('Выход-ENTER'); readln;
donewincrt;
end;
{ввод переменной вещественного типа с комментарием}
procedure In_real_comment(g: string; var a: real); label 1;
begin {$I-}
1: write (' ',g,' '); readln(a); {$I+}
if IOResult <>0 then begin writeln('Вы ошиблись!!! повторите ввод!');goto 1; end
else
end;
{процедура, определяющая перемиенную на четность}
procedure chetnost ( var a: integer);
var D: boolean;
begin
d:=odd(a); If d=true then
writeln (a,' нечетное')
else writeln(a,' четное'); writeln; readln;
end;
procedure In_integer_comment(g: string; var a:integer); label 1;
begin {$I-}
1: write (' ',g,' '); readln(a); {$I+}
if IOResult <>0 then begin writeln('Вы ошиблись, повторите ввод');goto 1; end
else end;
procedure Out_real_comment(g: string; var a: real);label 1;
begin {$I-} writeln;
1: write(g,'= ', a:8:6); {$I+}
if IOResult <>0 then begin writeln('Вы ошиблись, повторите ввод');goto 1; end;
end;
procedure Out_integer_comment(g: string; var a: integer);
begin
write(g,'= ', a); end;
procedure povtor(var f: boolean);
var x: char;
begin REPEAT ClrEol; writeln('Хотите перейти к выбору работ? Y или N?'); readln(x);
f:=(x='y')or(x='n');
if not f then
begin writeln('Вы ошиблись. Повторите ввод');
end;
UNTIL f;
if (x='y') or (x='Y') then f:=true else begin F:=false; donewincrt;
end;
end;
procedure povtorka(var f: boolean);
var x: char;
begin REPEAT ClrEol; writeln('Хотите повторить? Y или N?'); readln(x);
f:=(x='y')or(x='n');
if not f then
begin writeln('Вы ошиблись. Повторите ввод');
end;
UNTIL f;
if (x='y') or (x='Y') then f:=true else begin F:=false; donewincrt;
end;
end;
end.
Сообщение отредактировано: volvo -