Всё разложить на процедуры, а в конце для вызова использовать case.
const n=4;
var
mas:array [1..n] of integer;
a,i,b,c,d:integer;
begin
for i:=1 to n do
begin
writeln ('Введите число');
writeln;
readln (a);
writeln;
mas[i]:=a;
end;
writeln;
for i:=1 to n do
begin
write (mas[i]:3);
end;
b:=mas[2];
a:=1;
c:=1;
for i:=1 to n do
begin
if mas[i]=b then
begin
a:=a+1;
if a>c then
begin
d:=mas[i];
c:=a;
end;
end
else
a:=1;
if b<>mas[n] then
b:=mas[i+2];
end;
writeln;
for i:=1 to c do
write (d:3);
end.
const n=7;
var
mas:array [1..n] of integer;
i,a,c,max:integer;
begin
for i:=1 to n do
mas[i]:=random(10);
for i:=1 to n do
write (mas[i]:3);
for i:=1 to n do
if mas[i]>max then
begin
c:=i;
max:=mas[i];
end;
for i:=n downto c do
begin
a:=mas[i];
mas[i]:=mas[c];
mas[c]:=a;
end;
mas[n]:=0;
writeln;
for i:=1 to n-1 do
write (mas[i]:3);
end.
const n=3; m=4;
type ma=array [1..n,1..m] of integer;
var
a:ma;
b:ma;
c:ma;
p,i,j,h:integer;
begin
write('A:');
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
a[i,j]:=random(10);
write (a[i,j]:3);
end;
end;
writeln;
write('B:');
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
b[i,j]:=random(10);
write (b[i,j]:3);
end;
end;
writeln;
write('C:');
for i:=1 to n do
for j:=1 to m do
c[i,j]:=a[i,j]+b[i,j];
for i:=1 to n do
begin
writeln;
for j:=1 to m do
write (c[i,j]:4);
end;
for j:=1 to m do
for h:=j+1 to m do
if c[1,j]<c[1,h] then
for i:=1 to n do
begin
p:=c[i,j];
c[i,j]:=c[i,h];
c[i,h]:=p;
end;
writeln;
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
write (c[i,j]:4);
end;
end;
end.
Другие языки программирования и технологии
Помогите все задачи собрать в один проект!!! (pascal)
var vi: byte;
procedure res1;
const n=4;
var mas:array [1..n] of integer;
a,i,b,c,d:integer;
begin
for i:=1 to n do
begin
writeln ('Введите число');
writeln;
readln (a);
writeln;
mas[i]:=a;
end;
writeln;
for i:=1 to n do
begin
write (mas[i]:3);
end;
b:=mas[2];
a:=1;
c:=1;
for i:=1 to n do
begin
if mas[i]=b then
begin
a:=a+1;
if a>c then
begin
d:=mas[i];
c:=a;
end;
end
else
a:=1;
if b<>mas[n] then
b:=mas[i+2];
end;
writeln;
for i:=1 to c do
write (d:3);
end;
procedure res2;
const n=7;
var
mas:array [1..n] of integer;
i,a,c,max:integer;
begin
for i:=1 to n do
mas[i]:=random(10);
for i:=1 to n do
write (mas[i]:3);
for i:=1 to n do
if mas[i]>max then
begin
c:=i;
max:=mas[i];
end;
for i:=n downto c do
begin
a:=mas[i];
mas[i]:=mas[c];
mas[c]:=a;
end;
mas[n]:=0;
writeln;
for i:=1 to n-1 do
write (mas[i]:3);
end;
procedure res3;
const n=3; m=4;
type ma=array [1..n,1..m] of integer;
var
a:ma;
b:ma;
c:ma;
p,i,j,h:integer;
begin
write('A:');
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
a[i,j]:=random(10);
write (a[i,j]:3);
end;
end;
writeln;
write('B:');
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
b[i,j]:=random(10);
write (b[i,j]:3);
end;
end;
writeln;
write('C:');
for i:=1 to n do
for j:=1 to m do
c[i,j]:=a[i,j]+b[i,j];
for i:=1 to n do
begin
writeln;
for j:=1 to m do
write (c[i,j]:4);
end;
for j:=1 to m do
for h:=j+1 to m do
if c[1,j]<c[1,h] then
for i:=1 to n do
begin
p:=c[i,j];
c[i,j]:=c[i,h];
c[i,h]:=p;
end;
writeln;
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
write (c[i,j]:4);
end;
end;
end;
begin
writeln ('Выберите задачу',#10,'1) Задача',#10,'2) Задача',#10,'3) Задача');
readln(vi);
case vi of
1: res1;
2: res2;
3: res3;
else writeln ('неверный выбор!');
end;
end.
procedure res1;
const n=4;
var mas:array [1..n] of integer;
a,i,b,c,d:integer;
begin
for i:=1 to n do
begin
writeln ('Введите число');
writeln;
readln (a);
writeln;
mas[i]:=a;
end;
writeln;
for i:=1 to n do
begin
write (mas[i]:3);
end;
b:=mas[2];
a:=1;
c:=1;
for i:=1 to n do
begin
if mas[i]=b then
begin
a:=a+1;
if a>c then
begin
d:=mas[i];
c:=a;
end;
end
else
a:=1;
if b<>mas[n] then
b:=mas[i+2];
end;
writeln;
for i:=1 to c do
write (d:3);
end;
procedure res2;
const n=7;
var
mas:array [1..n] of integer;
i,a,c,max:integer;
begin
for i:=1 to n do
mas[i]:=random(10);
for i:=1 to n do
write (mas[i]:3);
for i:=1 to n do
if mas[i]>max then
begin
c:=i;
max:=mas[i];
end;
for i:=n downto c do
begin
a:=mas[i];
mas[i]:=mas[c];
mas[c]:=a;
end;
mas[n]:=0;
writeln;
for i:=1 to n-1 do
write (mas[i]:3);
end;
procedure res3;
const n=3; m=4;
type ma=array [1..n,1..m] of integer;
var
a:ma;
b:ma;
c:ma;
p,i,j,h:integer;
begin
write('A:');
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
a[i,j]:=random(10);
write (a[i,j]:3);
end;
end;
writeln;
write('B:');
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
b[i,j]:=random(10);
write (b[i,j]:3);
end;
end;
writeln;
write('C:');
for i:=1 to n do
for j:=1 to m do
c[i,j]:=a[i,j]+b[i,j];
for i:=1 to n do
begin
writeln;
for j:=1 to m do
write (c[i,j]:4);
end;
for j:=1 to m do
for h:=j+1 to m do
if c[1,j]<c[1,h] then
for i:=1 to n do
begin
p:=c[i,j];
c[i,j]:=c[i,h];
c[i,h]:=p;
end;
writeln;
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
write (c[i,j]:4);
end;
end;
end;
begin
writeln ('Выберите задачу',#10,'1) Задача',#10,'2) Задача',#10,'3) Задача');
readln(vi);
case vi of
1: res1;
2: res2;
3: res3;
else writeln ('неверный выбор!');
end;
end.
Юрий Суховичев
спасибо!!!
Похожие вопросы
- Помогите решить задачу по информатике 9 класс. Pascal ABC
- Помогите с задачей pascal пожалуйста. одна осталась до зачёта!
- помогите с задачей по Pascal abc!!!
- Пожалуйста помогите решить задачу Pascal
- Помогите написать задачу в Pascal.
- Помогите сделать задачу по информатике (Pascal)
- Помогите решить задачи Pascal
- Помогите решить задачу в Pascal!
- Помогите решить задачу через процедуры PASCAL
- Помогите решить задачу Pascal