Правила форума
Прочтите прежде чем задавать вопрос!
Код
uses crt;
var a:array[1..50,1..50] of integer;
i,j,m,n,i1,j1,i2,j2,i3,j3,i4,j4:integer;
key:char;
procedure input;
begin
for i:=1 to n do
for j:=1 to m do
begin
A[i,j]:=random(19)-9;
end;
end;
procedure out;
begin
for i:=1 to n do
begin
for j:=1 to m do
write(' ',a[i,j]);
writeln;
end;
end;
procedure generic;
begin
a[i1,j1]:=maxint;
for i:=1 to n do
for j:=1 to m do
begin
if (a[i,j]>0) and (a[i,j]<a[i1,j1]) then
begin
i1:=i;j1:=j;
end;
end;
a[i2,j2]:=maxint;
for i:=1 to n do
for j:=1 to m do
begin
if (a[i,j]>0) and (a[i,j]<a[i2,j2]) and (a[i,j]<>a[i1,j1]) then
begin
i2:=i;j2:=j;
end;
end;
a[i3,j3]:=a[1,1];
for i:=1 to n do
for j:=1 to m do
begin
if (a[i,j]<0) and (a[i,j]>a[i3,j3]) then
begin
i3:=i;j3:=j;
end;
end;
a[i4,j4]:=a[1,1];
for i:=1 to n do
for j:=1 to m do
begin
if (a[i,j]<0) and (a[i,j]>a[i4,j4]) and (a[i,j]<>a[i3,j3]) then begin i4:=i;j4:=j;end;
end;
end;
procedure outinfo;
begin
writeln('naim poloz 1: ',a[i1,j1]);
writeln('naim poloz 2: ',a[i2,j2]);
writeln('naib otric 1: ',a[i3,j3]);
writeln('naib otric 2: ',a[i4,j4]);
writeln;
writeln(a[i1,j1],' -> ',a[i2,j2],'; ',a[i2,j2],' -> ',a[i1,j1]);
writeln;
writeln(a[i3,j3],' -> ',a[i4,j4],'; ',a[i4,j4],' -> ',a[i3,j3]);
writeln;
end;
procedure swap;
begin
a[i2,j2]:=a[i2,j2]-a[i1,j1];
a[i1,j1]:=a[i1,j1]+a[i2,j2];
a[i2,j2]:=a[i1,j1]-a[i2,j2];
a[i3,j3]:=a[i3,j3]-a[i4,j4];
a[i4,j4]:=a[i4,j4]+a[i3,j3];
a[i3,j3]:=a[i4,j4]-a[i3,j3];
end;
begin
clrscr;
writeln('vvedite kol-vo strok');
readln(n);
writeln('vvedite kol-vo stolbcov');
readln(m);
writeln;
writeln('Ishodnuy massiv: ');
input;
out;
generic;
outinfo;
swap;
writeln('Modif massiv: ');
out;
key:=readkey;
end.
{условие задачи:В заданном двумерном массиве поменять местами минимальные элементы среди положительных и максимальные среди отрицательных.}
нужен текст модуля....
