Задача № 1: Дан целочисленный массив размера N. Вычислить сумму и количество положительных элементов, произведение и количество отрицательных элементов, произведение элементов до первого отрицательного. Отсортировать массив по возрастанию.
program massiv;
uses crt;
Const n=10;
var
i,j,k,kp:byte;
s,p:integer;
a:array[1..n] of integer;
M:integer; {переменная для перестановки}
begin
clrscr;
For i:=1 to n do
begin
write ('Введите a(',i,')=');
readln(a[i]);
end;
s:=0;
k:=0;
p:=1;
kp:=0;
For i:=1 to n do
begin
If a[i]>0 then
begin
s:=s+a[i];
k:=k+1;
end
else if a[i]<0 then
begin
p:=p*a[i];
kp:=kp+1;
end;
end;
For i:=1 to n-1 do
For j:=1 to N-i do
if a[j]>a[j+1] then
begin
M:=a[j]; {перестановка}
a[j]:=a[j+1];
a[j+1]:=M;
end;
writeln ('S=',s, 'k=',k);
writeln ('P=',p, 'k=',kp);
For i:=1 to n do
Writeln('a[',i,']=',a[i]);
readln
end.
Результат выполнения:
Задача № 2: Дана квадратная матрица порядка N заполненная не нулевыми элементами. Заменить нулями элементы матрицы лежащие ниже главной диагонали и выше побочной. Сколько не нулевых элементов осталось в матрице.
program matrix;
uses crt;
var
a:array[1..100,1..100] of integer;
i,j,n,k:integer;
begin
clrscr;
write('Введите размерность n=');
readln(n);
for i:=1 to n do
for j:=1 to n do
begin
write ('Введите a[',i,j,']=');
readln(a[i,j]);
end;
for i:=1 to n do
for j:=1 to n do
begin
if i>j then
a[i,j]:=0;
end;
for i:=1 to n do
for j:=1 to n do
begin
if i+j<n+1 then
a[i,j]:=0;
end;
k:=0;
for i:=1 to n do
for j:=1 to n do
begin
if a[i,j]>0 then k:=k+1;
end;
for i:=1 to n do
begin
for j:=1 to n do
write (a[i,j]:3);
readln
end;
Write('k=',k);
readln
end.
Результат выполнения:
Задача № 3: Дано предложение. Составить программу, которая выводит все вхождения в предложение заданного слога из двух символов. Вывести строку в обратном порядке.
program z_string;
uses crt;
var StringS1:string;
Slog:string;
Number:word;
function Lowercase(StringS:string):string;
var
CounterI:byte;
StringS1:string;
begin
StringS1:='';
for CounterI:=1 to length(StringS)do
if (StringS[CounterI] in ['A'..'Z']) or (StringS[CounterI] in ['A'..'П']) then
StringS[CounterI]:=chr(ord(StringS[CounterI])+32)
else
if (StringS[CounterI] in ['Р'..'Я']) then
StringS[CounterI]:=chr(ord(StringS[CounterI])+80)
else
if (StringS[CounterI]='Ё') then
StringS[CounterI]:='е';
Lowercase:=StringS;
end;
function NumberOf(StringS:string; Slogon:string):byte;
var
CounterI, Number:byte;
begin
Number:=2;
for CounterI:=1 to length(StringS) do
if Strings[CounterI]=Slogon then
inc(Number);
NumberOf:=Number;
end;
Function MoveSymbols(s:string):string;
var
i:integer;
Str:string;
begin
Str:='';
for i:=length(s) downto 1 do
Str:=Str+s[i];
MoveSymbols:=Str;
end;
begin
clrscr;
writeln('Введите предложение');
readln(StringS1);
writeln ('Введите слог, количество вхождений которой нужно найти');
readln(Slog);
Number:=NumberOf(Lowercase(StringS1),Lowercase(Slog));
Writeln('Слог',Slog,'встречается в предложении',Number,'раз');
writeln ('Строка с перествленными символами');
writeln(MoveSymbols(StringS1));
Writeln('Нажмите [Enter] для завершения программы');
readln;
end.
Результат выполнения:
Задача № 4: В магазин поступили товары. В накладной было указано: наименование товара, цена штуки товара и количество штук. Требуется вывести списки самых дорогих и самых дешёвых товаров и их количество, список товаров, количество которых было наибольшее.
program MAG;
uses crt;
type tovar=record
naim:string[45];
zena,kol:integer;
end;
var
magazin:array [1..5] of tovar;
i:integer;
maxk,max,min:integer;
begin
clrscr;
for i:=1 to 5 do
begin
writeln ('Введите наименование',' ',i,' ','товара');
readln(magazin[i].naim);
writeln ('Введите цену товара');
readln(magazin[i].zena);
writeln ('Введите количество товара');
readln(magazin[i].kol);
end;
max:=magazin[1].zena;
writeln('Самые дорогие товары');
for i:=1 to 5 do
begin
if max<magazin[i].zena then
begin
max:=magazin[i].zena;
if max=magazin[i].zena then
begin
writeln('Наименование товара:',' ',magazin[i].naim,' ', 'количество:',' '
,magazin[i].kol);
end;
end
else if max>magazin[i].zena then
begin
max:= magazin[i].zena;
if max=magazin[i].zena then
begin
writeln('---------------------------------------------');
writeln('Самые дешевые товары');
writeln('Наименование товара:',' ',magazin[i].naim,' ', 'количество:',' '
,magazin[i].kol);
end;
end;
end;
maxk:=magazin[1].kol;
writeln('---------------------------------------------');
writeln('Список товара, которого наибольшее количество');
for i:=1 to 5 do
if magazin[i].kol>maxk then
begin
maxk:=magazin[i].kol;
if maxk=magazin[i].kol then
begin
Writeln('Наименование товара:',' ', magazin[i].naim,' ', 'Количество:',' '
,magazin[i].kol);
end;
end;
readln;
end.
Результат выполнения:
Задача № 5: Багаж пассажира характеризуется количеством вещей и общим весом вещей. Данный файл, содержащий сведения о багаже каждого пассажира представляет собой запись, в которой определены следующие поля:
Ф.И.О.; Количество вещей; Вес (в килограммах).
а) определить, имеется ли два пассажира, баланс которых совпадает по числу вещей и различаются по весу;
б) выявить, имеется ли пассажир, багаж которого превышает багаж каждого из остальных пассажиров и по числу вещей и по весу;
в) выяснить, имеется ли пассажир, багаж которого состоит из одной вещи весом менее 30 кг .
program Fail;
uses crt;
type bag=record
FIO:string[30];
Kol:integer;
Ves:real;
end;
file_bag=file of bag;
var f:file_bag;
name:string;
s:integer;
procedure vvod_zapisi(var z:bag);
begin
writeln('Осуществляем ввод записей');
with z do
begin
writeln('Введите ФИО:');
readln(FIO);
writeln('Введите количество багажа:');
readln(Kol);
writeln('Введите вес багажа:');
readln(Ves);
end;
end;
procedure Vvod_file(var r:file_bag);
var n,i:byte;
z:bag;
begin
rewrite(r);
writeln('Введите количество записей');
readln(n);
for i:=1 to n do
begin
vvod_zapisi(z);
write(r,z);
end;
close(r);
readln;
end;
procedure vivod_zapisi(z:bag);
begin
write(z.FIO:20);
writeln(z.Kol:5);
writeln(z.Ves:0:0);
end;
procedure shapka;
begin
textcolor(5);
write('ФИО':20);
writeln('Количество':5);
writeln('Вес':5);
textcolor(15);
end;
procedure Vivod_file(var r:file_bag);
var n,i:byte;
z:bag;
begin
clrscr;
shapka;
reset(r);
i:=0;
while not(eof(r)) do
begin
seek(r,i);
read(r,z);
vivod_zapisi(z);
i:=i+1;
end;
close(r);
readln;
end;
procedure poisk_po_kol(var r:file_bag;s:integer);
var z:bag;
i:byte;
begin
writeln('Введите количество багажа');
readln(s);
reset(r);
i:=0;
clrscr;
shapka;
while not eof(r) do
begin
seek(r,i);
read(r,z);
if z.Kol=s then vivod_zapisi(z);
i:=i+1;
end;
readln;
end;
procedure poisk_pass(var r:file_bag);
var
A:array[1..100] of integer;
z:bag;
i,n:integer;
max:integer;
begin
for i:=1 to n do
read(a[i]);
readln;
max:=1;
For i:=2 to n do
if a[i]>max then max:=i;
Writeln('Номер записи',a[max]);
readln;
end;
procedure poisk_bag(var r:file_bag);
var
z:bag;
i:byte;
begin
reset(r);
i:=0;
clrscr;
shapka;
while not eof(r) do
begin
seek(r,i);
read(r,z);
if (z.kol=1) and (z.ves<30) then vivod_zapisi(z);
i:=i+1;
end;
readln;
end;
procedure menu(var r:file_bag; s:integer);
var k:byte;
begin
repeat
clrscr;
writeln('Что будем делать?');
writeln('1: Создадим список пассажиров');
writeln('2: Выведим список');
writeln('3: Поиск по количеству багажа');
Writeln('4: Пассажир с превышенным багажом');
writeln('5: Пассажир с 1 багажом менее 30 кг');
writeln('6: Выход');
writeln('Ваш выбор');
readln(k);
case k of
1:vvod_file(r);
2:vivod_file(r);
3:poisk_po_kol(r,s);
4:poisk_pass(r);
5:poisk_bag(r)
end;
until k=6;
end;
{Основная программа}
begin
clrscr;
writeln('Введите наименование программы');
readln(name);
assign(f,name);
menu(f,s);
end.
Задача № 6: Составить программу, выводящую на монитор графическое изображение с использованием основных возможностей графической библиотеки Graph. Перед составлением программы необходимо нарисовать эскиз рисунка на миллиметровой бумаге с указанием основных координат.
program graphic;
uses Graph;
var
driver, mode, errorcode:integer;
xm,ym,i,j:integer;
pi,pi300,x1,y1,x2,y2,sc:real;
st1,st2,st3:string;
function f(x:real):real;
begin
f:=sin(x)+sin(2*x)+sin(3*x)-1-cos(x)-cos(2*x); {функция для построения
графика}
end;
begin
st1:='x';
st2:='y';
st3:='Press ENTER';
sc:=50;
mode:=2;
driver:=detect;
InitGraph(driver, mode,'C:\TP\BGI');
if errorcode<>grok then
begin
writeln('Ошибка Graph');
closegraph;
halt;
end;
xm:=getmaxx div 2;
ym:=getmaxy div 2;
line(xm,20,xm,460); {ось x}
line(20,ym,620,ym); {ось y}
outtextxy(630,ym,st1); {маркировка оси x}
outtextxy(xm,10,st2); {маркировка оси y}
pi:=3.1415926;
pi300:=pi/300;
x1:=-pi;
for i:=0 to 24 do
begin
line(xm+round(80*x1),230,xm+round(80*x1),250);
x1:=x1+pi300*25;
end;
x1:=-pi;
while x1<pi do
begin
y1:=f(x1);
x2:=x1+pi300;
y2:=f(x2);
line(xm+round(80*x1), ym-round(sc*y1),
xm+round(80*x2),ym-round(sc*y2));
x1:=x2;
end;
outtextxy(270,470,st3);
readln;
closegraph;
end.
