(5 оценок, среднее: 4,80 из 5)
Загрузка...
Учебная работа. Отчет по практике: Основные приемы работы в среде ТР
отчет
по учебной практике
по программированию
Выполнила:
Волоснова А.С
учащаяся
группы 202АС
Проверила:
Гайсагалеева Б.М
Актобе 2010
ДНЕВНИК.
ДАТА
ТЕМА
ПРОДЕЛАННАЯ РАБОТА
ПРОВЕРКА
14.06.10
Виды загрузки. Главные приемы работы в среде ТР. Редактирование текста программки, процесс отладки.
Исследовали главные виды загрузки и приемы работы в ТР и процесс отладки.
14.06.10
Исследование установок редактирования отладки программ при помощи командного меню Pascal.
Исследовали команды редактирования отладки программ при помощи командного меню Pascal.
14.06.10
Оформление программки. Разделы. Описание разделов. Предназначение каждой части программки.
Исследовали, как оформлять программки, также предназначение каждой части программки.
15.06.10
Разработка постановки задачки. Разработка простых программ с внедрением установок присваивания, ввода, вывода.
Научились составлять программки с внедрением простых операторов ввода, вывода, присваивания.
15.06.10
Форматы ввода, вывода. Команды Read, Readln, Write, Writeln.
Исследовали форматы ввода и вывода и команды Read, Readln, Write, Writeln.
15.06.10
Определение типов данных. Объявление данных. Константы. Метки. Комменты. Разделители. признаки концов строк на Pascale
Исследовали разные типы данных и признаки концов строчки на Pascal
16.06.10
Команды ветвления. Полные и не полные команды ветвления.
Исследовали полную и не полную формы установок ветвления.
16.06.10
Составные операторы. Служебные скобки. Внедрение собственных операторов команды ветвления.
Исследовали разные виды составных операторов.
16.06.10
Виды выражения. Сопоставления с текстовых и числовых критерий.
Исследовали виды выражений и сопоставления с текстовыми и числовыми критериями.
17.06.10
Составные условия. Дизайна составных критерий. Союзы составных критерий. Примеры внедрения составных критерий.
Исследовали составные условия их оформление и применение.
17.06.10
Решение задач по выбору функции по значению аргумента. Команда выбора. Определение принадлежности точки к фигуре, к функции. Словесные условия.
Решали задачки по выбору функции по значению аргумента, определяли принадлежность точки к фигуре, к функции.
17.06.10
Решение задач. Внедрения. Ограничения отладки.
Решали задачки по ограничению отладки
18.06.10
Организация цикла с условием продолжения. Составные операторы в цикле WHILE DO. Применение. Решение задач. Блок-схема. Отладка.
Изучали составные операторы в цикле WHILE DO. Решали задачки.
18.06.10
Оператор цикла с условием окончания UNTIL, REPEAT. Правила внедрения.
Исследовали оператор цикла с условием окончания UNTIL, REPEAT. Решали задачки.
18.06.10
Решения задач. Блок-схема. Отладка. Результаты.
Решение задач.
19.06.10
Оператор цикла с параметром FOR TO DO. Правила внедрения. Составные операторы в цикле. Решение задач с внедрением оператора цикла с параметром.
Исследовали оператор цикла с параметром FOR TO DO. Решение задач.
19.06.10
Нахождение суммы, произведения частей ряда. Параметр цикла.
Научились отыскивать сумму и произведение частей ряда.
19.06.10
Цикл с параметром, с подборкой конца. Применение.
Исследовали оператор цикла с параметром
21.06.10
Производные типы. Одномерные массивы. Типы индекса. Внедрение значений постоянного типа.
Разглядели одномерные массивы, производные типы. Выполнили практическую работу.
21.06.10
Многомерные массивы.
Разглядели многомерные массивы. Выполнили практическую работу.
21.06.10
Синтаксис задания постоянного типа.
Исследовали синтаксис постоянного типа
22.06.10
Двумерный массивы. Матрица матриц. Создание формирование и работа с двумерными массивами. Поиск частей в матрицах.
Исследовали двумерный массив и работу с двумерным массивом.
22.06.10
Упорядочивание и сортировка частей. Решение задач на матрицы.
Научились сортировать элементы массива. Решали задач на матрицы.
22.06.10
Составление программ с внедрением матриц.
Составляли программки с внедрением матриц.
23.06.10
Процедуры без характеристик. Процедуры с параметрами. характеристики —
Исследовали различные виды процедур: с параметрами, без характеристик, параметры-
23.06.10
характеристики случайных типов. Синтаксис процедур.
Разглядели характеристики случайных типов. И синтаксис процедур.
23.06.10
Определение оператора процедуры. Примеры использования процедур
Исследовали оператора процедуры и его применение.
24.06.10
Описание процедуры- функции. Вызов функции. Побочные эффекты. Рекурсивные функции.
Исследовали описание процедуры- функции, её вызов. Побочные эффекты.
24.06.10
характеристики— функции и параметры- процедуры.
Исследовали параметры- функции и параметры- процедуры.
24.06.10
Процедуры и шаговая детализация.
Разглядели шаговую детализацию.
25.06.10
Строковые величины. Работа со строковыми величинами. Формирование строк с учетом конца строчки. Подсчет, подмена частей. Удаление знаков, ведущих, ведомых пробелов. Поиск подходящего знака.
Научились работать со строковыми величинами.
25.06.10
Работа со обычными функциями строк- Concat, Copy, Insert, Delete, POS, Length.
Научились работать со обычными строковыми функциями: Concat, Copy, Insert, Delete, POS, Length.
25.06.10
Функции STR, Val, UpCase.
Исследовали функции: STR, Val, UpCase.
26.06.10
Простые комбинированные типы. Описание комбинированных типов. Работа с элементами комбинированного типа. Подборка частей.
Исследовали простые комбинированные типы, их описание, принцип работы.
26.06.10
Многоуровневые записи.
Исследовали многоуровневые записи
26.06.10
Оператор присоединения.
Исследовали оператор присоединения.
28.06.10
Обозначение множеств в Паскале. Задание множественного типа и множественная переменная. Операции над огромными количествами.
Исследовали огромного количества в Паскале.
28.06.10
Процедуры работы с огромными количествами.
Исследовали процедуры работы с огромными количествами.
28.06.10
Примеры использования множественного типа
Разглядели примеры множественного типа
29.06.10
Файлы и работа с ними. Доступ к файлам. Названия файлов. Файлы логических устройств. Инициация файла.
Исследовали файлы, доступ к ним, их имена.
29.06.10
Процедуры и функции для работы с файлами Reset, Rewrite, Append, Assign
Исследовали процедуры и функции для работы с файлами: Reset, Rewrite, Append, Assign
29.06.10
Процедуры и функции для работы с файлами Reset, Rewrite, Append, Assign
Исследовали процедуры и функции для работы с файлами: Reset, Rewrite, Append, Assign
30.06.10
Текстовые файлы. Их объявление. Работа с ними.
Исследовали текстовые файлы, и работу с ними.
30.06.10
Буферная переменная и её внедрение.
Исследовали буферную переменную.
30.06.10
Буферная переменная и её внедрение.
Исследовали буферную переменную.
01.07.10
Работа с графикой в Паскале. Графический режим. установка драйверов графики. Инициализация драйверов графики. Описание драйверов.
Делали работы в графическом режиме Паскаль.
01.07.10
Команды вычеркивания точек, линей, окружностей, дуг, секторов и обычных геометрических фигур.
Исследовали команды вычеркивания обычных геометрических фигур.
01.07.10
Команды вычеркивания точек, линей, окружностей, дуг, секторов и обычных геометрических фигур.
Исследовали команды вычеркивания обычных геометрических фигур.
02.07.10
Модуль Граф. Модули установки цветов. Модули выбора стилей заливок- SetLineStile, SetFileStile, FlodFileStile.
Исследовали модуль Граф. И разные модули заливки и стилей.
02.07.10
Вычеркивание геометрических фигур с анимацией и организация движения и перемещения фигур по экрану.
Исследовали вычеркивание геометрических фигур с анимацией и организацией движения и перемещения фигур по экрану.
03.07.10
Разработка программки графики с внедрением всех модулей Граф.
Исследовали разработку программ с внедрением модуля Граф.
03.07.10
Разработка программки графики с внедрением всех модулей Граф.
Исследовали разработку программ с внедрением модуля Граф.
03.07.10
Модули работы с текстом в графическом режиме. Модуль CRT. Системный модуль System.
Исследовали принцип работы в графическом режиме.
СОДЕРЖАНИЕ.
1. Линейная программка на Паскаль.
2. программка с ветвлениями.
3. Повторяющаяся программка.
4. Массивы.
5. Процедуры и функции.
6. Файловые данные в Паскале.
7. Записи в Паскале.
8. Строчки.
9. Графика в Турбо-Паскале.
Раздел: Линейные методы
1.Описание: программка вычисления периметра треугольника.
program one;
uses crt;
var a,b,P:integer;
begin clrscr;
writeln (‘a=’);
readln (a);
writeln (‘b=’);
readln (b);
P:=(a+b)*2;
writeln (‘P=’,P);
end.
2.Описание: программка вычисления площади треугольника.
program one;
uses crt;
var a,b,h,s:real;
begin clrscr;
writeln(‘A= B= H= ‘);
readln(a,b,h);
s:=h*(a+b)/2;
writeln(‘S=’,s:0:4);
readln;
end.
3.Описание: программка вычисления количества теплоты по формуле ‘
Q
=
c
*
m
*(
t
2-
t
1)
program one;
uses crt;
var Q,c,m,t2,t1:integer;
begin clrscr; textcolor(10);
writeln (‘c=’);
readln (c);
writeln (‘m=’);
readln (m);
writeln (‘t2=’);
readln (t2);
writeln (‘t1=’);
readln (t1);
Q:=c*m*(t2-t1);
writeln(‘Q=c*m*(t2-t1)=’,Q);
end
4.Описание: программка вычисления величины силы тока I на участке цепи с R Ом и U В.
program one;
uses crt;
var I,U,R:real;
begin clrscr; textcolor(10);
writeln (‘U=’); readln (U);
writeln (‘R=’);
readln (R);
I:=U/R;
writeln(‘I=’,I:5:0);
end.
5.Описание: программка вычисления расстояния меж 2-мя точками с данными координатами x1,
y
1,
x
2,
y
2
program one;
uses crt;
var r:real; x1,x2,y1,y2:integer;
begin clrscr;
writeln (‘znachenie x1=’);
readln (x1);
writeln (‘znachenie x2=’);
readln (x2);
writeln (‘znachenie y1=’);
readln (y1);
writeln (‘znachenie y2=’);
readln (y2);
r:=sqrt(sqr(x2-x1)+sqr(y2-y1));
writeln (‘rasstoyanie=’,r);
end.
6.Описание: Известна сумма средств,имеющаяся у покупателя и стоимость одной ед. продукта. Сколько ед. продукта может приобрести клиент и какова его сдача?
program one;
uses crt; var a,b,c:real; begin clrscr;
writeln (‘summa deneg=’);
readln (a);
writeln (‘cena ed.tovara=’);
readln (b);
c:=a/b;
writeln (‘ostatok=’,c);
end.
7.Описание: Сумма цыфр введенного трехзначного натурального числа.
program one;
uses crt;
var a:integer; s,d,e,f:real;
begin clrscr;
writeln (‘vvedi 3-hznachnoe chislo’);
readln (a);
s:=a div 100;
d:=a mod 100 div 10;
e:=a mod 100 mod 10;
writeln (d:5:0); writeln (s:5:0); writeln (e:5:0);
f:=d+s+e; writeln (f:5:0);
end.
8.Описание: Отыскать площадь по известной стороне равностороннего треугольника.
program one;
uses crt;
var a,S:real;
begin clrscr;
writeln(‘Vvedite storonu treugolnika’);
readln(a);
S:=0;
S:=a*a*sqrt(3)/4;
writeln (‘Ploshad ravna:’, S:3:1);
readln;
end.
9.Описание: Бабушка вяжет в недельку 3 пары детских носков, пару дамских и пару мужских и реализует их. Считая, что в месяце 4 недельки,найти,какую Прибыль бабушка имеет за месяцю.
program one;
uses crt; var det,jen,muj,ned,mes:integer;
begin clrscr;
writeln (‘det:=’);
readln (det);
writeln (‘jen:=’);
readln (jen);
writeln (‘muj:=’);
readln (muj);
ned:=muj+jen+det;
mes:=4*ned;
writeln(‘dohod=’,mes);
end
10.Описание: Пирамида из звездочек
program one;
uses crt;
var j,i:integer;
begin clrscr;textcolor(9+5);
for i:=1 to 25 do begin gotoxy(40-i,i);
for j:=2 to 2*i do write(‘*’);
end;
readln;
end.
11.Описание:Вычислить произведение
Program one;
Uses crt;
Var a,b,p:integer;
begin clrscr;textcolor(9+5);
writeln (‘a= b=’);
readln (a,b);
p:=a*b;
textcolor (9+16);
writeln (‘p=,p’);
end.
12.Описание: Вычисление радиуса
Program one;
Uses crt;
Var l:real; r:integer;
begin clrscr;textcolor(5);
writeln (‘R=’);
readln (r);
l:=2*pi*r;
writeln (‘radius=,r’);
end.
13.Описание: Вычисление периметра квадрата
Program one;
Uses crt;Var а:integer;
begin clrscr;textcolor(5);
writeln (‘a=’);
readln (a);
p:=4*a;
writeln (‘perimetr=,р’);
end.
14.Описание: Выведение введенного числа
Program one;
Uses crt;Var s:integer;
begin clrscr;textcolor(5);
writeln (‘s=’);
readln (s);
writeln (‘вы ввели число,s’);
end.
15.Описание: Вычисление плотности по количеству обитателей и площади.
Program one;
Uses crt;Var k,s:integer; p:real;
begin clrscr;textcolor(5);
writeln (‘число обитателей=’);
readln (k);
writeln (‘plosh=’);
readln (s);
p:=s/k;
writeln (‘plotnost=’,p);
end.
Раздел: Разветвляющиеся методы
1.Описание: Вычисление уравнения
program one;
var x,y:integer;; begin write(‘x=’); readln(x); if x>0 then y:=sqr(sin(x)) else y:=1-2*sin(sqr(x)); writeln (y); end.
2.Описание: Деление нацело
Program ch;
Uses crt;
Var a,m,n:integer;
Begin clrscr;
Writeln (‘m= n=’);
Readln (m,n);
a:=m mod n;
If a=0 then write (m div n)
Else write(‘net resh’)
End.
3 .Описание: Написать программку на языке
Pascal
для реализации разветвляющегося метода, где x – известные величины.
program one;
var x,y:real;
begin writeln(»);
write(‘Vvedite x=’);
readln(x); if x<=0.8 then
y:=exp(x-1)+3.14 else if (0.8<x) and (X<=5.27) then
y:=ln(x+5.96) else y:=2*x;
writeln(‘y=’,y:4:2); readln;end.
4. Описание: Написать программку на языке Pascal для реализации разветвляющегося метода, где x – известные величины.
program one; var x,y,z:real; begin writeln(»); write(‘Vvedite x=’); readln(x); write(‘Vvedite y=’); readln(y);
if x-y>0 then z:=1/(x*y) else z:=sqr(x)*sqr(y); writeln(‘z=’,z:4:2); readln; end.
5 .Описание: Написать программку на языке Pascal для реализации разветвляющегося метода, где x=ln a2
, y=1/arctg b; a,b – известные величины. 
program one; var x,y,z,a,b:real; begin writeln(»); write(‘Vvedite a=’); readln(a); write(‘Vvedite b=’); readln(b); x:=ln(sqr(a)); y:=1/arctan(b); if x-y>0 then z:=1/(x*y) else z:=sqr(x)*sqr(y); writeln(‘z=’,z:4:2); readln; end.
6. Описание: Заданы два прямоугольных параллелепипеда. Можно ли расположить их один в другом?
program one; var a1,a2,b1,b2,c1,c2:integer; begin writeln(‘vvedite shiriny, dliny, vusoty 1’);
readln(a1,b1,c1); writeln(‘vvedite shiriny, dliny, vusoty 2’); readln(a2,b2,c2); if ((a1<=a2) and (b1<=b2) and (c1<=c2)) or ((a1>a2) and (b1>b2) and (c1>c2)) then writeln(‘mogno’) else writeln(‘nelzya’); readln; end.
7. Описание: номер клеточки на шахматной доске 8х8 определяется 2-мя целыми числами — номер вертикали и номер горизонтали. Даны 4 целых положительных числа a,b,c,d. Узнать, лупит ли ферзь, находящийся на клеточке (a,b) клеточку(c,d)
program one; var a,b,c,d:integer; begin read(a,b); read(c,d); if (a=c) or (b=d) or (абс(c-a)=абс(d-b))
then write(‘ga’) else write(‘HeT’);
readln
end
8. Описание: Может быть, ли выстроить треугольник с данными сторонами
program one;
uses crt;
var a,b,c:real;
begin clrscr;
writeln(‘стороны треугольника= ‘);
readln(a,b,c);
if (a<b+c) and (b<a+c)
and(c<a+b) then write(‘можно’)
else write(‘нереально’);
readkey;
end.
9 .Описание: Даны три неравных числа
a
,
b
,
c
. Составить программку нахождения квадрата большего из этих чисел.
program one; var a,b,c:real; begin read(a,b,c); if (a>b) and (a>c) then write(‘a^2= ‘,a*a:1:4); if (b>a) and (b>c) then write(‘b^2= ‘,b*b:1:4); if (c>a) and (c>b) then write(‘c^2= ‘,c*c:1:4); readln end.
10.Описание:Вычисление большего из 2-ух чисел
Program b_ch;
Uses crt;
Var a,b:integer;
Max:integer;
Begin clrscr;
Writeln (‘a= b=’);
Readln (a,b);
If a>b then max:=a else max:=b
Writeln (‘max=’,max);
End.
11.Описание:Вычисление наименьшего из 2-ух чисел
Program m_ch;
Uses crt;
Var a,b:integer;
Min:integer;
Begin clrscr;
Writeln (‘a= b=’);
Readln (a,b);
If a<b then min:=a else min:=b
Writeln (‘min=’,min);
End.
12.Описание:Деление нацело
Program ch;
Uses crt;
Var a,b,c:integer;
Begin clrscr;
Writeln (‘a= b=’);
Readln (a,b);
C:=a mod b;
If c=0 then write (a div b)
Else write(‘net resh’)
End.
13.Описание: Сопоставление чисел трехзначного числа
Program ch;
Uses crt;
Var a,b,c,d,e,i:integer;
Begin clrscr;
Writeln (‘a=’);
Readln (a);
D:=a div 100;
E:=b mod 100 div 10;
C:=I mod 10;
writeln(d,e,c);
if (a<b) and (b<i) then writeln (‘ravny’)
else writeln (‘ne ravny’);
End.
14.Описание: Принадлежит ли число интервалу
Program ch;
Uses crt;
Var a:integer;
Begin clrscr;
Writeln (‘a=’);
Readln (a);
if (a>=(-5)) and (a<=3) then writeln (‘prinadl’)
else writeln (‘ ne prinadl’);
End.
15.Описание:Сопоставить 3 стороны треугольника
Program ch;
Uses crt;
Var a,b,c:integer;
Begin clrscr;
Writeln (‘a= b= c=’);
Readln (a,b,c);
if (a=c) or (a=b) then writeln (‘ravnobedr’)
else writeln (‘ ne ravnobedr’);
End.
Раздел: методы повторяющейся структуры:
1.Описание: Написать программку на языке Pascal для реализации повторяющегося метода 
n, х – известные величины.
var i,j,fact,n:integer;
s,x:real;
begin
writeln;
write(‘Vvedite n=’);
readln(n);
write(‘Vvedite x=’);
readln(x);
s:=0;
for i:=1 to n do begin fact:=1;
for j:=1 to i do Fact:=fact*j;
s:=s+(1/fact+sqrt(абс(x)));
end;
writeln(‘s=’,s:4:2);
readln;
end.
2.Описание: Написать программку на языке Pascal для реализации повторяющегося метода
n – известные величины.
program one;
var i,j,n,zn,factorial:integer; s,x:real; begin writeln; write(‘Vvedite n=’); readln(n); s:=0; factorial:=1; zn:=1; for i:=1 to n do begin zn:=zn*(-1); factorial:=factorial*i; s:=s+(zn*(i+1)/factorial); end; writeln(‘s=’,s:4:3); readln; end.
3.Описание: Написать программку на языке Pascal для реализации повторяющегося метода
s=1/1*2-1/2*3+…+(-1)n+1
/n(n+1) n – известные величины.
program one;
var i,j,n,zn:intege r; s,x:real; begin writeln; write(‘Vvedite n=’); readln(n); s:=0; zn:=-1; for i:=1 to n do begin zn:=zn*(-1); s:=s+zn/(i*(i+1)); end; writeln(‘s=’,s:4:2); readln; end.
4
.Описание: Написать программку на языке Pascal для реализации повторяющегося метода
n – известные величины.
program one;
var i,j,n:integer; stepen:integer; s:real; begin writeln; write(‘Vvedite n=’); readln(n); s:=0; for i:=1 to n do begin stepen:=1; for j:=1 to 5 do begin stepen:=stepen*i; end; s:=s+1/stepen; end; writeln(‘s=’,s:4:2); readln; end.
5. Описание: Написать программку, которая выводит целые четные числа с клавиатуры и складывает их , пока не будет введено число 0.
Program 5;
Uses crt;
Var n,s:integer.;
Begin clrscr;
S:=0;
Repeat;
Writeln(vvedi chislo);
Readln(n);
S:=s+n;
Until n=0;
Writeln(s=,s);
Readln;
End.
6. Описание: Составить программку, подсчета суммы
S
первых 1000 членов гармонического ряда 1+1/2+1/3+…+1/
N
Program 1;
Uses crt;
Var s:real; n;integer;
Begin clrscr;
S:=0; n:=0;
Repeat;
N:=n+1;
S:=s+1/n;
Until n=1000;
Writeln(s);
End.
7. Описание: Напечатать 20 первых степеней числа 2.
Program 2;
Uses crt;
Var n,s:longint;
Begin clrscr;
S:=1;
N:=1;
Repeat S:=s*2;
Writeln(s,);
N:=n+1;
Until n>20; Readln;
End.
8. Описание:Известны оценки по информатике всякого из 20 учеников класса. Сначала перечня Перечислены все «5»,потом другие оценки. сколько учеников имеют оценку «5»?
Program 5;
Uses crt;
Var x,n:Word;
Begin clrscr;
Writeln(vvedi ocenki);
Readln(x);
N:=0;
While x=5 do begin n:=n+1;
Writeln(vvedi ocenki);
Readln(x);
End;
Writeln(imeyut 5,n,uchenikov);
Readln;
End.
9. Описание: Вычислить больший общий делитель 2-ух натуральных чисел А и В, использую для этого метод Евклида. Будем уменьшать всякий раз большее из чисел на величину наименьшего до того времени, пока оба числа не станут равными.
Program nod;
Uses crt;
Var a,b:integer;
Begin clrscr;
Writeln(vvedi 2 chisla);
Readln(a,b);
While a<>b do if a>b then a:=a-b else b:=b-a;
Writeln(nod=,a);Readln;
End.
10.Описание: программка подсчета суммы
S
первых 1000 членов гармонического ряда 1+1/2+1/3+1/4+…+1/
N
Program S;
Uses crt;
Var s:real;n:integer;
Begin clrscr;
S:=0; N:=0;
While n<1000 do begin N:=n+1;
S:=s+1/n;
End;
Writeln(s);
Readln;
End.
11.Описание:Имеется четыре (
A
,
B
,
C
,
D
) числа. нужно ответить на вопросец:«Правда ли что все посреди этих чисел есть равные?»Ответ вывести в виде текста:«Правда», либо «Неправда».
Program z1;
var a,b,c,d:integer; {описываем имеющиеся переменные}
begin writeln(‘vvedite chislo a’); {вводим все числа по очереди}
readln(a);
writeln(‘vvedite chislo b’);
readln(b);
writeln(‘vvedite chislo c’);
readln(c);
writeln(‘vvedite chislo d’);
readln(d);
if (a=b)or (a=c) or (a=d)or (b=c) or (b=d) or (d=c) then writeln (‘pravda’) else writeln (‘nepravda’);
readln;
end.
12.Описание: Составить программку вычисления и выдачи на печать суммы (произведения)
N
частей нескончаемого ряда. Оформить проверку задания.
Y
=(-512)*256*(-128)*64…… Общая формула имеет вид:
y
=
±
210-
i
program z2;
var i,j,zn,n:integer; s:real;
begin writeln;
writeln(‘vvedite kolichestvo elementov ryada’);
write(‘N=’); {вводим количество частей ряда}
readln(n);
s:=1;
for i:=1 to n do begin zn:=1;
for j:=1 to i+1 do begin zn:=zn*(-1);
end;
s:=s*(-zn)*(exp((10-i)*ln(2))); {вводим формулу}
end;
writeln(‘s=’,s:4:2);
readln;
end.
13.Описание: Дана функция
Y
=1-[
x
-2]^2/10 вычислить и напечатать значения данной функции для поочередных значений
x
=
c
,
x
=
c
+(
b
+1),
x
=
c
+2(
b
+1),
x
=
c
+3(
b
+1) где а=1;
b
=9;с=2. Считать до того времени пока сумма
Y
+6 не станет отрицательной.
program zad3;
const b=9; c=2;
var x,n:integer; f,s:real; function y(x:integer):real;
begin y:=1-(sqr(x-c)) / (b+1);
end;
begin writeln(‘Y=1-[x-2]^2/10’);
n:=0;
repeat x:=c+n*(b+1);
inc(n);
f:=y(x);
write(‘x’,nactiveXx,’ ‘);
writeln(‘y’,n,’= ‘,f:6:5)
until f+6<0;
readln
end.
14.Описание: Имеется массив А из
N
случайных чисел (
A
(
n
)), посреди которых есть положительные, отрицательные и равные нулю. Напечатать лишь те числа из массива которые больше предшествующего числа.
program z4;
uses Crt;
const MAX = 100;
var mas : array[1..MAX] of integer; n,i : byte; k,p: integer;
begin ClrScr;
Write(‘N:=’);
Readln(n);
for i:=1 to n do begin Write(‘vvedite ‘,i,’ element massiva:>’);Readln(mas[i]); end;
begin k := 0;
for i := 1 to n do begin if mas[i]>mas[(i-1)] then writeln (mas[i]); end;
readln; end;
end.
15.Описание: Составить программку вычисления числового ряда для известного числа членов ряда
N
.
Y
=(7+35
/1)(8-3-4
/2)(9+33
/3)….
program z5;
var i,j,zn,n:integer; s:real;
begin writeln;
writeln(‘vvedite kolichestvo elementov ryada’);
write(‘N=’);
readln(n);
s:=1;
for i:=1 to n do begin zn:=1;
for j:=1 to i+1 do begin zn:=zn*(-1);end;
s:=s*((6+i)+exp((zn*(6-i))*ln(3))/i);end;
writeln(‘s=’,s:4:2);
readln;
end.
Раздел : Массивы
1 Описание: Отыскать, сколько раз любой элемент встречается в массиве
Доп массивов не создавать.
Program msv;
Const Size=10; Diap=10;
var a: array [1..Size] of integer; i,n,k,j:integer;
begin writeln;
repeat write(‘Введите размерность 1 массива (от 2 до ‘,Size,’):’);
Read (n);
Until (n>1) and (n<=Size); Randomize;
a [1]:=Random(Diap);
Write (‘A= ‘, a[1],’ ‘);
For i: =2 to n do begin A[i]:=Random (Diap);
Write (a[i],’ ‘); End;
writeln;
k:=0;
For i: =1 to n do if a[i]=0 then Inc(k);
If k>0 then writeln (‘0: ‘,k);
For i: =1 to n-1 do if a[i]<>0 then begin K: =1;
For j: =i+1 to n do if a[i]=a[j] then begin A[j]:=0;
Inc (k); End;
writeln (a[i],’: ‘,k); end;
end.
2. Описание: Соединить 2 упорядоченных массива по возрастанию.
Program msv;
const Size=10; Step=5;
var a,b:array [1..Size] of integer; c:array [1..2*Size] of integer; i,n1,n2,ia,ib,ic:integer;
begin writeln;
repeat write(‘Введите размерность 1 массива (от 2 до ‘,Size,’):’);
read (n1);
until (n1>1) and (n1<=Size);
Randomize;
a[1]:=Random(Step);
write (‘A= ‘,a[1],’ ‘);
for i:=2 to n1 do begin a[i]:=a[i-1]+Random(Step);
write (a[i],’ ‘); end;
writeln;
repeat
write(‘Введите размерность 2 массива (от 2 до ‘,Size,’):’);
read (n2);
until (n2>1) and (n2<=Size);
b[1]:=Random(Step);
write (‘B= ‘,b[1],’ ‘);
for i:=2 to n2 do begin b[i]:=b[i-1]+Random(Step);
write (b[i],’ ‘);
end;
writeln;
ia:=1; ib:=1;
write (‘C= ‘);
for i:=1 to n1+n2 do begin if a[ia]<=b[ib] then begin c[i]:=a[ia];
if ia<n1 then Inc(ia) else begin a[n1]:=b[ib];
if ib<n2 then Inc (ib); end; end
else begin c[i]:=b[ib];
if ib<n2 then Inc(ib) else begin b[n2]:=a[ia];
if ia<n1 then Inc(ia); end; end;
write (c[i],’ ‘);
end;
writeln;
end.
3. Описание: Дан массив чисел. Отыскать
наибольшее
.
Program msv;
Uses crt;
Var i,n,max:integer; a:array[1..100] of integer;
begin clrscr;
read(n);
for i:=1 to n do read(a[i]); {ввод чисел в массив}
max:=a[1];
for i:=2 to n do if a[i] > max then max:=a[i]; {сравнивается с уже отысканным большим,}
write(‘maksimalnoe chislo = ‘,max);
readln;
end.
4. Описание: Отыскать сумму частей числового массива
Program msv;
uses crt;
Var i,n,s:integer; a:array[1..1000] of integer;
begin clrscr;
read(n);
for i:=1 to n do read(a[i]); {ввод значений в массив}
s:=0;
for i:=1 to n do s:=s+a[i];
write(‘Summa = ‘,s); readln;
readln;
end.
5. Описание: Дан числовой массив. Вычислить сумму частей,имеющих четное
Program msv;
Uses crt;
type mas=array[1..100] of integer;
Var a:mas; i,n:integer; function calc(b:mas;m:integer):integer;
var i,s:integer;
begin s:=0;
for i:=1 to m do;
if i mod 2=0 then s:=s+b[i];
calc:=s;
end;
begin clrscr;
read(n);
for i:=1 to n do read(a[i]);
write(‘Сумма всякого второго элемента = ‘,calc(a,n));
readln;
readln;
end.
6. Описание: Дан массив знаков. Вычислить, сколько в нем частей ‘a’
Program msv;
Uses crt;
Var i,n,s:integer; a:array[1..100] of char;
begin clrscr;
readln(n); {Объявление а:array[1..1000] of char значит,}
for i:=1 to n do readln(a[i]);
s:=0;
for i:=1 to n do readln(a[i]);
s:=0;
for i:=1 to n do if a[i]=’a’ then s:=s+1;
write(‘Kolichestvo elementov ravnyh «a» = ‘,s);
readln;
end.
7. Описание: Дан двумерный массив целых чисел размерностью
NxN
. Отыскать сумму его частей
Program msv;
Uses crt;
Var s,i,j,n:integer; a:array[1..10,1..10] of integer;
begin clrscr;
read(n);
for i:=1 to n do for j:=1 to n do read(a[i,j]);
for i:=1 to n do for j:=1 to n do s:=s+a[i,j];
write(‘Сумма частей = ‘,s);
readln;
readln;
end.
8. Описание: По данному массиву
X
[7] сформировать массив
Y
, элементы которого рассчитываются по формуле
Y
[
i
]= |
X
[
i
]-
B
|, где
B
— наибольший элемент массива
X
program msv;
const Size=7; { Размерность массива }
var x:array [1..Size] of real; b:real; i:integer;
begin writeln;
writeln (‘Жду ввода частей массива размерностью ‘,Size,’:’);
for i:=1 to Size do begin write (‘x[‘,i,’]=’);
readln (x[i]); end;
b:=x[1];
for i:=2 to Size do if x[i]>b then b:=x[i];
writeln (‘Наибольший элемент=’,b:10:3);
writeln (‘Начальный Новейший’);
writeln (‘массив массив’);
for i:=1 to Size do begin write (x[i]:10:4);
x[i]:=абс(x[i]-b);
writeln (x[i]:10:4); end;
end.
9. Описание: Отыскать наибольший элемент в линейном массиве.
Вывести итог на экран
program msv;
uses crt;
const
nn = 10; var max, i: integer; a: array[1..nn] of integer; begin clrscr;
for i := 1 to nn do a[i] := random(500);
max := a[1];
for i := 2 to nn do if a[i] > max then max := a[i];
for i := 1 to nn do write(a[i], ‘ ‘); writeln;
writeln(‘Max = ‘, max);
readkey;
end.
10. Описание: Отсев. Удалить в данном массиве
x
(
n
) излишние (не считая первого) элементы так, чтоб оставшиеся создавали вырастающую последовательность(за один просмотр массива)
program msv;
uses crt;
const n = 10; {dlina massiva}
var a: array[1..n] of integer; i, max, j, k, mi: integer; begin clrscr; randomize;
for i := 1 to n do begin a[i] := random(51);
write(a[i], ‘ ‘); end;
max := a[1];
k := 2; {t.k. uslovie zadachi «preobarzovat’ za odin prosmotr massiva», to}
{k ne mozhet bit’ bol’she N, chem mi vospol’zuemsya v cikle}
for i := 2 to n do begin if k > n then break;
if a[i] <= max then {esli a[i] <= max to udalyaem etot element}
begin for j := i to n — 1 do {etogo cikl mog bi ne viiti, no u nas est’ K}
a[j] := a[j + 1];
dec(i); end;
if a[i] > max then begin max := a[i];
mi := i; {MI — poziciya maksimuma v massive} end;
inc(k); {uvelichivaem K, k = [2..n]} End;
Write (#10#13, a[1], ‘ ‘);
For i: = 2 to mi do Write (a[i], ‘ ‘);
readkey;
end.
11. Описание: В массиве
X
из
n
частей любой из частей равен 0, 1 либо 2. Переставить элементы массива так, чтоб поначалу размещались нули, потом единицы и двойки. Доп массив не применять.
программка расширена для способности переставлять элементы массива, являющимися хоть какими числами (не только лишь 0, 1, 2)
Program msv;
Const n = 10; {кол-вл частей массива}
var a, b, t : integer; X: array[1..n] of integer; {сам массив из n частей}
BEGIN For a := 1 to n do {ввод массива X} Begin Write (‘Введите X [‘, a, ‘]: ‘);
Readln(X[a]); End;
for a := 1 to n do begin t := X[a];
b := a — 1;
While (b>=0) and (t<X[b]) do Begin X [b+1]:= X[b];
B: = b — 1; End;
X [b+1]:= t; end;
for a := 1 to n do {вывод результата}
Write(X[a]:2);
END. {конец программки}
12. Описание: Операции с массивом, сортировка суммирование.В одномерном массиве, состоящем из
N
вещественных частей, вычислить:1) количество частей массива, равных 0;2) сумму частей массива, расположенных опосля малого элемента.
Упорядочить элементы массива по возрастанию модулей частей.
Program msv;
Uses CRT;
Const N = 10; {сколько всего частей}
Var a: Array[1..N] of Real; i, j: Byte; Zero: Byte; Min: Real; Summ: Real;
Procedure Print;
Begin For i := 1 to N do Write(a[i]:0:1,’ ‘);
Writeln;End;
Procedure CreateMassive;
BeginWriteln(‘Начальная последовательность’);
For i := 1 to N do Begin a[i] := Random(4);
a[i] := a[i] — 2; {Этот и предшествующий операторы можно соединить}
End;
Print;
Writeln;End;
Begin ClrScr;Randomize;
CreateMassive;
Min := a[1];
For i := 2 to N do Begin Summ := Summ + a[i];
If (a[i] < Min) then Begin Min := a[i];
Summ := 0; End; End;
Writeln(‘Малый элемент ‘,Min:0:1,’. Сумма частей опосля: ‘,Summ:0:1);
For i := 1 to N do Begin For j := i + 1 to N do If (абс(a[j]) < абс(a[i])) then Begin a[i] := a[i] + a[j];
a[j] := a[i] — a[j];
a[i] := a[i] — a[j]; End; End;
Writeln(#13#10,’Отсортировання последовательность’); Print;
For i := 1 to N do If a[i] = 0 then Inc(Zero);
Write(#13#10,’Нулевых частей: ‘,Zero);ReadKey;
End.
13. Описание: Вычислить угол меж 2-мя данными векторами размерности 8, используя функцию скалярного произведения
a
=
arccos
((
x
,
y
)/((
x
,
x
)*(
y
,
y
)))
program msv;
uses crt;
type TVector = array[1..8] of Real;
function scal(var Vec1, Vec2 : TVector):real; var p : Real; i : integer;
begin p:=0;
for i:=1 to 8 do p:=p+(Vec1[i]*Vec2[i]);
scal := p;end;
var Vec1, Vec2 : TVector; i : integer; sc, a, angle : Real;
BEGIN writeln(‘Условие:’);
writeln(‘ вычислить угол меж 2-мя данными векторами размерности 8,’);
writeln(‘ используя функцию скалярного произведения’);
writeln;
Writeln(‘Ввод первого вектора’);
for i := 1 to 8 do begin Write(‘Vec1[‘, i, ‘] : ‘);
Readln(Vec1[i]); end;
Writeln(‘Ввод второго вектора’);
for i := 1 to 8 do begin Write(‘Vec2[‘, i, ‘] : ‘);
Readln(Vec2[i]); end;
sc := scal(Vec1, Vec2);
a:= sc/sqrt(scal(Vec1,Vec1)*scal(Vec2,Vec2)); {Рассчитывается косинус}
if a=0 then angle:=90 else angle:=arctan(sqrt(1-a*a)/a)*180/pi;
if a=-1 then angle:=180;
if angle<0 then angle:=180+angle;
writeln(‘Угол меж векторами: ‘,angle:7:3,’ градусов’);
END.
14. Описание: Вычислить сумму 2-ух векторов, 1-ый из которых вводится, а элементы второго рассчитываются по формуле
b
[
i
]:=
sin
(
i
*
x
), где 0<=
x
<=3.14
program msv;
const Nm = 10; {размерность вектора}
var Vec1, Vec2, ResVec : array[1..Nm] of Real; i : integer; x : Real; N : integer;
BEGIN writeln(‘Условие :’);
writeln(‘ вычислить сумму 2-ух векторов, 1-ый из которых вводится, а элементы’);
writeln(‘ второго рассчитываются по формуле b[i]:=sin(i*x), где 0<=x<=3.14′);
writeln;
Write(‘введите размерность вектора (N<‘, Nm, ‘): ‘);
Readln(N);
if n <= Nm then begin Writeln(‘Ввод вектора’);
for i := 1 to N do begin Write(‘Vec1[‘, i, ‘] : ‘);
Readln(Vec1[i]); end;
Write(‘Введите X (от 0 до 3.14) : ‘); Readln(x);
if (X <= 3.14) and (X >= 0) then begin for i := 1 to N do begin Vec2[i] := sin(Vec1[i]*X); ResVec[i] := Vec1[i]*Vec2[i]; {сходу же вычисляем произведние} end;
Write(‘Результирующий вектор : ‘); {выводим на экран итог}
for i := 1 to N do Write(ResVec[i]:6:2); end else Writeln(‘Введено неправильное X’);
end else Writeln(‘неправильная размерность’);
END.
15. Описание: Создается случайный массив из 5 частей. Поменять все четные значения на 1, нечетные – на 0.
Program msv;
uses crt;
const n=5;
var a:array[1..n] of integer; i:integer;
begin clrscr; randomize;
for i:=1 to n do begin a[i]:=random(9);
write(a[i]); end;
writeln;
for i:=1 to n do begin if odd(a[i])=false then a[i]:=1 else a[i]:=0;
write(a[i]);
end;
readkey;
end.
Раздел: Процедуры и функции
1.Описание: Отыскать последовательности целых чисел те, которые встречаются в ней ровно дважды.
program one;
uses crt;
type mas=array[1..100]of integer; func=function(var x:mas):integer; var a:mas; j,n,m,x:integer;
function kolichestvo(var c:mas):integer; var k,i:integer;
begin k:=0;
for i:=1 to n do if c[i]>m then k:=k+1;
kolichestvo:=k; end;
procedure deist(var b:mas; operation:func);
begin writeln(‘b[j]’);
for j:=1 to n do readln(b[j]);
for j:=1 to n do write(b[j],’ ‘); writeln;
x:=operation(a); end;
begin clrscr;
writeln(‘vvedite celoe chislo m i razmer massiva(n)’);
readln(m,n);
deist(a,kolichestvo);
writeln(‘kolichestvo=’,x);
readkey;
end.
2.Описание: Процедура отображения рамки в текстовом режиме
program frame;
uses Crt;
procedure Frm(l:integer; t:integer; w:integer; h:integer);
var x,y:integer; i:integer; c1,c2,c3,c4,c5,c6:char;
begin clrscr;
c1:=chr(218); c2:=chr(196);
c3:=chr(191); c4:=chr(179);
c5:=chr(192); c6:=chr(217); GoToXY(l,t);
write(c1);
for i:=1 to w-2 do write(c2);
write(c3);
y:=t+1;
x:=l+w-1;
for i:=1 to h-2 do begin GoToXY(l,y);
write(c4);
GoToXY(x,y);
write(c4);
y:=y+1; end;
GoToXY(l,y);
write(c5);
for i:=1 to w-2 do write(c2);
write(c6);
end;
begin Frm(2,2,15,10);
readln;
end.
3.Описание: Произведение нечетных частей
Program one;
type massiv= array [1..100] of integer;
var A1,A2:massiv; i,j:integer; n1,n2:integer; function pr_nec(m:massiv; n:integer):integer;
var i,j,pr:integer;
begin pr:=1;
for i:=1 to n do if odd(m[i]) then pr:=pr*m[i];
pr_nec:=pr;
end;
begin writeln(‘Vvedite PERVYI massiv:’);
write(‘ego razmer «n»: ‘); readln(n1);
for i:=1 to n1 do begin write(‘A1[‘,i,’]=’); readln(A1[i]); end;
writeln(‘_______________________’);
writeln(‘Vvedite VTOROI massiv:’);
write(‘ego razmer «n»: ‘); readln(n2);
for i:=1 to n2 do begin write(‘A2[‘,i,’]=’); readln(A2[i]); end;
writeln(‘_______________________’);
writeln;
writeln(‘Vi vveli:’);
write(‘A1: ‘); for i:=1 to n1 do write(A1[i],’ ‘); writeln;
write(‘A2: ‘); for i:=1 to n2 do write(A2[i],’ ‘); writeln;
writeln;
writeln(‘Proizvedenie iz A1= ‘,pr_nec(A1,n1));
writeln(‘Proizvedenie iz A2= ‘,pr_nec(A2,n2));
readln;
end.
4.Описание: Нахождение тангенса tg и котангенса ctg угла, используя выражения sin(x)cos(x) и оборотное ему.
Program one;
uses crt;
var y1,y2,z: real; function tg (x : real) : real;
begin tg := sin(x)/cos(x);
end;
function ctg (x : real) : real;
begin ctg := cos(x)/sin(x);
end;
Begin clrscr;
write (‘input x: ‘);
readln (z);
y1:=tg(z); y2:=ctg(z);
writeln (‘tg (‘,z:0:2,’)=’,y1:0:2);
writeln (‘ctg (‘,z:0:2,’)=’,y2:0:2);readln;
End.
5. Описание: Найти наибольшее число из 4 введенных, методом сопоставления их поначалу попарно, а потом итог меж собой.
program one;
uses crt;
var a,b,c,d,z,x,y,x1,y1:integer; function max(x,y:integer):integer;
begin if x>y then max:=x else max:=y;
end;
begin clrscr;
writeln(‘Vvedite chisla’);
readln(a,b,c,d);
x1:=max(a,b); y1:=max(c,d); z:=max(x1,y1);
writeln(‘max=’,z);
readkey;
end.
6.Описание: Вычислить денек недельки по дате
program Kalendar;
uses crt; var y,d,m,c,w: integer; {m-mesiac,d-den, y-god }Procedure WriteDay(d,m,y:Integer);
constDays_of_week: rray [0..6] of String [11] =(‘Voskresen`e’,’Ponedelnik’,’Vtornik’, ‘ Sreda’, ‘ Chetverg’, ‘ Piatnica’, ‘ Subbota’) ;
Begin if m <3 then begin m := m + 10;
y := y — 1;end else m := m — 2;c := y div 100;y := y mod 100;w := (d+(13*m-1) div 5+y+y div 4+c div 4-2*c+777) mod 7;
WriteLn(Days_of_week[w] );end;
Procedure InputDate(var d,m,y : Integer);
Begin Write(‘Vvedite datu v formate DD MM GG ‘);
ReadLn(d,m,y);
if (d>=1)and (d<=31) and (m>=1) and (m<=12) and (y>=1582) and (y<=4903) then Writeday(d,m,y) else begin writeln (‘Nekorrektnyj vvod!’);end;end;
BEGIN clrscr;
InputDate(d,m,y);
readkey;
End.
7. Описание: Нахождение процента от числа
Program one;
uses crt;
var k,n:byte; x:real; function procent(n,m:byte):real;
begin procent:=m*100/n;
end;
begin clrscr;
writeln(‘Vvedite chisla’);
readln(k,n);
x:=procent(k,n);
writeln(‘x=’,x:5:2);
readkey;
end.
8. Вывести данное число звездочек.
program one;;
uses crt;
var n:byte; function zvezda(n:byte):real; var i:integer; s:string;
begin i:=1;
s:=»;
while i<=n do begin s:=s+’*’;
inc(i); end;
writeln(s); end;
begin clrscr;
writeln(‘Vvedite chislo’); readln(n);
zvezda(n); readkey;
end.
9. Описание: Функция возведения числа в степень. С учетом дробных чисел и личных случаев, когда числа отрицательные либо равны нулю
program one;
Uses crt;
var x,y,z:real; Function Pow(A,B:Real):Real; Var T,R:Real; L:integer;
Begin T := Абс(A);
If A < 0 Then R := (-1)*Exp(B*Ln(T)) else if A > 0 Then R := Exp(B*Ln(T)) else R:=0;
L := round(B);
If (L mod 2 = 0) Then R:=Абс(R);
If (B=0) Then R:=1;
Pow:=R;
End;
BEGIN clrscr;
Writeln(‘vvedite chislo:’);
readln(x);
Writeln(‘vvedite stepen:’);
readln(y);
z:=Pow(x,y);
Writeln(z:0:2);
readkey;
END.
10. Описание: Вывести данный знак данное количество раз
program one;
uses crt;
var n:byte; l:string; function zvezda(n:byte;l:string):real; var i:integer; s:string;
begin i:=1;
s:=»;
while i<=n do begin s:=s+l;
inc(i); end;
writeln(s); end;
begin clrscr;
writeln(‘Vvedite chislo’); readln(n);
writeln(‘Vvedite simvol’); readln(l);
zvezda(n,l);
readkey;
end.
11.Описание: Найти к чему поближе наименьшее из 2-ух чисел: к их среднему арифметическому либо среднему геометрическому.
Program one;
vara,b : real; average : real; geometricmean : real; minstr : string;function min(a,b : real) :real;
begin min := a;
minstr := ‘Pervoe’;
if (b < a) then begin min := b;
minstr := ‘Vtoroe’;end;end;
beginwrite(‘Vvedite 1-e chslo: ‘);readln(a);
write(‘Vvedite 2-e chslo: ‘);readln(b);
average := (a + b) / 2;
geometricmean := sqrt(a*a + b*b);
a := min(a,b);
writeln(‘Naimenshee chislo — ‘,minstr,’ (‘,a:0:3,’)’);
write(‘Blize k srednemu ‘);
if (абс(average — a) < абс(geometricmean — a)) thenbegin writeln(‘arifmeticheskomu (‘,average:0:3,’)’);
end else begin writeln(‘geometricheskomu (‘,geometricmean:0:3,’)’);end;
readln;
end.
12.Описание:Возведение в степень для целого показателя, вычисляемого за время log2(степень).
Program power_maximal;
Uses crt;
Var a,b,c: integer; function power (x,pow:integer):integer; var res: integer;
begin res := 1;
while (pow > 0) do beginif (pow and 1 = 1) then res:= res * x;
x := x * x;
pow := pow shr 1;end;
power := res; end;
Begin Clrscr;
Writeln (‘input a,b: ‘);
Readln (a,b);
c:=power(a,b);
Writeln(‘a^b = ‘,c);
Readkey;
End.ъ
13.Описание:Арккосинус числа. Нахождение из математических суждений
var ca,al,albeg: real; function ArcCos(arg:real):real;
var r:real;
begin if (абс(arg)>1) then begin writeln(‘ Unavailable argument ‘);
halt; end;
if абс(arg)<0.000001 then r := pi/2 else r := ArcTan(sqrt(1/arg/arg-1)); { arccos }
if arg<0 then r:=pi-r;
ArcCos := r; end;
begin albeg:=pi/2+0.2;
ca := cos(albeg);
al := arccos(ca);
writeln(‘ArcCos(‘,ca:10:7,’)=’,al:10:7,’ AlBeg=’,albeg:10:7,
‘ ChekSum =’,al-albeg,’ Must be sero’);
readln;
end.
14.Описание:Есть ли в строке числовые значения
Function NumInStr(S: String): Boolean;
VAR C, I: INTEGER; N: BOOLEAN;
BEGIN; I:=0;
Repeat;
I:=I+1;
C:=Ord(S[I]);
N:=( (C >= 48) AND (C <= 57) );
Until (NOT N) OR (I=Length(S));
NumInStr:=N;
END;
15.Описание:Нахождение функции способом половинного деления
program half_del;
uses crt;
type ms=array[1..100] of real; { [x,y] }
var Eps,XH,DX,Y,z,X,YH,P,S,A,B:real; N,U,Er:integer; masx,masy:ms;Function F(X:real):real;
beginF:=exp(x)+x*x-2
end;
Function FuncA(Eps,s,p,YH:real):real;
begin if F(p)*F(s)<0 then begin YH:=0.5*(p+s);
while абс(F(YH)) > EPS do begin If F(p)*F(YH) <0 then S:=YH else P:=YH;
YH:=0.5*(P+S) end; end else er:=1;
FuncA:=YH; end;
procedure P1(a,b,XH:real; N:integer); var z,q:real; u:integer;
begin if x>1 then begin Z:=sqrt(X*sqrt(X-1));
a:=FuncA(Eps,s,p,YH);
for U:=1 to N do begin masx[U]:=X;
masy[U]:=sin(x)/z;
X:=X+DX; end;
{else writeln(‘ Error: x<1 ‘);} end; end;
Begin clrscr;
write (‘vvedite eps: ‘); readln(eps);
Write (‘vvedite dx: ‘); readln(DX);
write (‘vvedite N: ‘); readln(N);
write (‘vvedite x>1 :’); readln(x);
if x1; writeln;
Writeln (‘———————‘);
Writeln (‘ | X | Y ‘);
writeln (‘———————‘);
P1(a,b,XH,N);
for U:=1 to N do writeln(»,masx[u]:10:7,’ ‘,masy[u]:10:7);readln;
end.
Раздел: Файлы
1.Описание: Решает простые арифметические примеры записанные в файл.
program pn12;
var f:text; s,sa,sb:string; c:char; i,a,b,o,j,code:integer; m,op:set of char;
begin m:=[‘1′,’2′,’3′,’4′,’5′,’6′,’7′,’8′,’9′,’0’];
op:=[‘+’,’-‘,’*’,’/’];
assign(f,’file.txt’);reset(f);
while not(eof(f)) do begin readln(f,s);
writeln(s);
for i:=2 to length(s)-1 do if (s[i] in op)and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;
sa:=»;
while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;
j:=j+1 end;
j:=1;
sb:=»;
while (s[i+j] in m) and (i+j<=length(s)) do begin sb:=sb+s[i+j];
j:=j+1 end;
val(sa,a,code);val(sb,b,code);
case s[i] ofactiveXO:=a+b;
‘-‘:O:=a-b;
‘*’:O:=a*b;
‘/’:O:=a div b; end;
writeln(a,s[i],b,’=’,O,’ ‘)
end;end; close(f);
readln;
end.
2.Описание: Работа с текстовыми файлами предугадывает собой: создание, редактирование, добавление, удаление.
Program one;
uses Dos,Crt;
var f :text;
FileName :string[9];
st :string; ch :char; vibor :byte;
procedure Head;
begin Writeln(‘esli vy otkazyvaetes ot deistviya,to naberite v nazvanii faila simvola»»‘);
Write(‘vvedite imya faila:>’);
Readln(FileName);
if FileName=’~’ then halt(1) else Assign(f,FileName); end;
procedure TextEdit;
begin Writeln(‘Seichas vy smojetedobavlyat informaciyu v file.’);
Writeln(‘esli vyzahotite prekratit vvod, to naberite sleduschuyu posledovatelnost:»~~»‘);
repeat Write(‘>’);Readln(st);
if st<>’~~’ then Writeln(f,st);
until st=’~~’; end;
procedure WriteToFile;
begin Head;
ReWrite(f);
TextEdit;
Close(f);
Writeln(‘Vy okonchili vvodit info v file.Najmite lubuyu knopku…’);
ReadKey; end;
procedure ReadFromFile;
Head;
Reset(f);
if IOresult<>0 then begin Writeln(‘file ‘,FExpand(filename),’ ne sushestvuet.’);
Writeln((Y/N).’);
ch:=ReadKey;
if (ch=’Y’) or (ch=’y’) then ReadFromFile;
end else begin Writeln(‘Soderjimoe faila:’);Writeln;
while not eof(f) do begin Readln(f,st);
Writeln(‘>’,st); end;
Close(f);
Writeln;
Writeln(‘Najmite lubuyu knopku’);
ReadKey; end;end;
procedure AddToFile;
begin Head;
Append(f);
if IOresult<>0 then begin
Writeln(‘faila ‘,FExpand(filename),’ ne sushestvuet.’);
Writeln(‘hotite vvesti drugoe imya faila?(Y/N).’);
ch:=ReadKey;
if (ch=’Y’) or (ch=’y’) then AddToFile; end else begin TextEdit; Close(f);
Writeln(‘Vy okon4ili vvodit info v file.Najmite lubuyu knopku…’);
ReadKey; end; end;
procedure DelFile;
begin Head;
Reset(f);
if IOresult<>0 then begin Writeln(‘file ‘,FExpand(filename),’ ne sushestvuet.’);
Writeln(‘hotite vvesti drugoe imya file??(Y/N).’);
ch:=ReadKey; if (ch=’Y’) or (ch=’y’) then DelFile; end else begin Writeln(‘vy uvereny 4to hotite udalit etot file?(Y/N)’);
ch:=ReadKey; if (ch=’Y’) or (ch=’y’) then Erase(f);
Writeln(‘vy tolko 4to udalili file.Najmite lubuyu klavishu..’);
Readkey; end; end;
procedure Menu;
begin repeat repeat ClrScr;
Writeln(‘1. record file / sozdanie faila’);
Writeln(‘2. read file’);
Writeln(‘3. Dobavlenie info v file’);
Writeln(‘4. delet file’);
Writeln(‘5. Exit’);
Write(‘Vash vybor:>’);Readln(vibor);
until (vibor>0) and (vibor<6);
Writeln;
Write(‘‚л ўлЎа «Ё : ‘);
case vibor of 1:begin Writeln(‘ record file / sozdanie faila’);
WriteToFile; end;
2:begin Writeln(‘read file’);
ReadFromFile; end;
3:begin Writeln(‘ Dobavlenie info v file’);
AddToFile; end;
4:begin Writeln(‘delet file’);
DelFile; end; end;
until vibor=5; end;
begin Menu;
end.
3.Описание: Дан файл, содержащий текст и арифметические выражения вида, а*в, где * — один из символов +, -, *, /.Выписать все арифметические выражения и вычислить их значения
program pn12;
var f:text; s,sa,sb:string; c:char; i,a,b,o,j,code:integer; m,op:set of char;
begin m:=[‘1′,’2′,’3′,’4′,’5′,’6′,’7′,’8′,’9′,’0’];
op:=[‘+’,’-‘,’*’,’/’];
assign(f,’e:tptp6Arif.dat’);reset(f);
while not(eof(f)) do begin readln(f,s);
writeln(s);
for i:=2 to length(s)-1 do if (s[i] in op)and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;
sa:=»;
while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;
j:=j+1 end;
j:=1; sb:=»;
while (s[i+j] in m) and (i+j<=length(s)) do begin sb:=sb+s[i+j];
j:=j+1 end;
val(sa,a,code);val(sb,b,code);
case s[i] ofactiveXO:=a+b;
‘-‘:O:=a-b; ‘*’:O:=a*b; ‘/’:O:=a div b; end;
writeln(a,s[i],b,’=’,O,’ ‘)
end; end;
close(f);
end.
4.Описание: Вывести наибольшее число из файла
in
.
txt
Program one;
var t:text; i,p,code:integer; s:string; m:array[1..100] of real; max:real;
begin assign(t,’in.txt’); reset(t);
read(t,s);
i:=0;
repeat p:=pos(‘ ‘,s);
inc(i);
val(copy(s,1,p-1),m[i],code);
delete(s,1,p);
until p=0;
max:=m[1];
for p:=2 to i do if m[p]>max then max:=m[p];
writeln(‘MAX= ‘,max);
close(t);
readln;
end.
5.Описание: Перекодирование файла из формата
DOS
в формат
Windows
.
Program one;
var f,g:text; i,p,n:integer; m:array [1..100] of string; s:string;
begin assign(f,’in.txt’); reset(f);
assign(g,’out.txt’); rewrite(g);
while not eof(f) do begin readln(f,s); {считываем еще одну строчку}
i:=0; {ставим счётчик слов на 0}
repeat inc(i); {увеличиваем счётчик текущего ПРЕДЛОЖЕНИЯ}
p:=pos(‘ ‘,s); {смотрим где находится пробел}
m[i]:=copy(s,1,p-1); {записываем текущее слово в массив}
delete(s,1,p); {то слово, которое заприсали в массив — удаляем}
until p=0; {****************}
n:=i+1; {конец массива}
if s[length(s)]=’.’ then begin m[n]:=copy(s,1,length(s)-1); m[1]:=m[1]+’.’ {то эту точку перемещаем на 1 слово}
end else m[n]:=s; {а если нет точки — то просто его записываем в массив}
writeln(g);;
for i:=n downto 1 do write(g,m[i],’ ‘); {идём с конца массива в начало и записываем слова в оборотном порядке}end;
writeln(‘PEREZAPISANO…’);readln;
close(f); close(g);
end.
6.Описание: Удаление последующих друг за другом нескольких пробелов из файла.
Program one;
const
FileName: String = ‘Strings.txt’;
VAR f: Text; S: String;
BEGIN Assign(f, FileName); {$I-}Reset(f); {$I+}
if IOResult = 0 then begin ReadLn(f, S); Close(f) end;
WriteLn(‘input string: ‘,S);
while (POS(‘ ‘, S) > 0) do delete(S, POS(‘ ‘,S), 1);
if ( length(S) > 1) and (S[1] = ‘ ‘) then Delete(S, 1, 1);
if (length(S)>1) and (S[length(S)] = ‘ ‘) then Delete(S, length(S), 1);
writeln(‘output string: ‘,s);
readln;
END.
7.Описание:
Вывести содержимое файла в оборотном порядке в новейший файл.
program one;
uses crt;
var fl1,fl2:text;a,b:string; i,l:longint;
begin clrscr;
assign(fl1,’input.txt’);
assign(fl2,’output.txt’); reset(fl1); readln(fl1,a);
close(fl1);
l:=length(a);
for i:=l downto 1 do b:=b+a[i];
rewrite(fl2); write(fl2,b);
close(fl2);
write(b); readln;
end.
8.Описание:
Бинарный поиск элемента в типизрованном longint файле.
program searches;
uses crt,dos;
type longint_file=file of longint;
procedure files_names_query(var read_file,error:string; var search_value:longint);
var f:text;
begin error:=»;
write(‘‘считываемый файл: ‘);
readln(read_file);
assign(f,read_file);
reset(f);
if (ioresult=0) then begin close(f);
write(‘находимое
readln(search_value);
end else begin error:=’ошибка:файл не существует’; end; end;
function bin_search(left,right,search_value:longint;var f:longint_file):boolean;
var center,value,new_left,new_right,right_value,center_value:longint;
begin if (left=right) then begin seek(f,left);
read(f,value);
if (value=search_value) then begin bin_search:=TRUE;
end else begin bin_search:=FALSE; end;
end else begin center:=((left+right) div 2)+1;
seek(f,right);
read(f,right_value);
seek(f,center);
read(f,center_value);
if ((search_value>=center_value)and(search_value<=right_value)) then begin new_left:=center;
bin_search:=bin_search(new_left,right,search_value,f);
end else begin new_right:=center-1;
bin_search:=bin_search(left,new_right,search_value,f); end; end; end;
function search(read_file:string; search_value:longint):boolean;
var f:longint_file;
finded:boolean;
elements_count:longint;
begin assign(f,read_file);
reset(f);
finded:=FALSE;
elements_count:=filesize(f);
finded:=bin_search(0,elements_count-1,search_value,f);
close(f);
search:=finded; end;
procedure writing_to_file(write_file:string;finded:boolean;begin_time:longint);
var f:text; hour,minutes,seconds,seconds100:Word; end_time:longint; time:real;
begin gettime(hour,minutes,seconds,seconds100);
end_time:=minutes*60*100+seconds*100+seconds100;
time:=(end_time-begin_time)/100;
assign(f,write_file);
rewrite(f);
if (finded) then writeln(f,’ok’) else writeln(f,’error’);
writeln(f,time:4:2);
close(f); end;
procedure writing(finded:boolean; begin_time:longint);
begin if (finded) then begin writeln(‘Element finded complete’);
end else begin writeln(‘Element not finded’); end;
readln; end;
var read_file,write_file,error,search_value_string:string; hour,minutes,seconds,seconds100:Word;
begin_time,search_value:longint; k:integer; result:boolean;
begin gettime(hour,minutes,seconds,seconds100);
begin_time:=minutes*60*100+seconds*100+seconds100;
if (paramstr(1)<>») then begin read_file:=paramstr(1);
search_value_string:=paramstr(2);
val(search_value_string,search_value,k);
write_file:=paramstr(3);
result:=search(read_file,search_value);
writing_to_file(write_file,result,begin_time);
end else begin files_names_query(read_file,error,search_value if (error=»)
then begin result:=search(read_file,search_value);
writing(result,begin_time);
end else begin writeln(error);
writeln(‘нажмите Enter для продолжения.’);
readln; end; end;
end.
9.Описание:
Вывести таблично результаты расчета функции y=sin(x)/x на обозначенном спектре в файл.
Program one;
Const M=24;
Var FName: Text; AB,H,X: Real;
Function F(X:Real):Real;
Begin F:=Абс(Sin(X)/X);
End;
Begin Write (‘vvedite na4alo diapazona: ‘);
ReadLn (A);
Write (‘vvedite konec diapazona: ‘);
ReadLn (B);
WriteLn(‘sozdayu LA-BA.TAB’);
H:=(B-A)/M;
X:=A;
Assign(FName,’LA-BA.TAB’);
ReWrite(FName);
WriteLn (FName,’X | F(X)’);
While (X<=B) Do Begin WriteLn (FName,X,’ | ‘,F(X));
X:=X+H;
End;
Close (FName);
End.
10.Описание
: Дан файл, содержащий текст. Сколько слов в тексте? сколько цифр в тексте?
program one;
Const mn=[‘0’..’9′];
Var f3:text; i,j,ch,sl:integer; name:string; s:char; wrd :string;
Begin writeln(‘vvedite imya faila’);
readln(name);
assign(f3,name);
reset(f3);
s:=’ ‘; sl:=0; ch:=0;
while not eof(f3) do begin readln(f3,wrd);
i:=1;
While i<=length(wrd) do begin if wrd[i]<>’ ‘ then sl:=sl+1;
while (wrd[i]<>’ ‘) and (i<=length(wrd)) do inc(i);
inc(i) end; end;
close(f3);
reset(f3);
while not eof(f3) do begin while not eoln(f3) do begin read(f3,s);
if (s in mn) then ch:=ch+1;
end; readln(f3); end;
writeln(‘4islo slov: ‘,sl,’ 4islo cifr: ‘,ch);
close(f3);
End.
11.Описание:
Поменять синонимами слова в файле
program ;
var f1,f2,f3:text; i,n,k,l:integer; s,sout,ss,slovoT,slovo,sinonim:string;
begin assign(f1,’text1.txt’);
assign(f2,’text2.txt’); assign(f3,’text3.txt’);
rewrite(f1);
writeln(‘‚ўҐ¤ЁвҐ ⥪бв:’);
repeat readln(s);
writeln(f1,s)
until s=»;
close(f1); reset(f1);
rewrite(f3);
while not(eof(f1)) do begin readln(f1,s);
s:=s+’ ‘;
sout:=»;
while length(s)>0 do begin l:=pos(‘ ‘,s);
slovoT:=copy(s,1,l-1);
delete(s,1,l);
reset(f2);
while not(eof(f2)) do begin readln(f2,ss);
k:=pos(‘,’,ss);sinonim:=copy(ss,1,k-1);
if sinonim=slovoT then slovoT:=copy(ss,k+1,length(ss)-k) end;
close(f2);
sout:=sout+slovot+’ ‘ end;
writeln(s);
writeln(f3,sout) end;
close(f3); reset(f3);
while not(eof(f3)) do begin readln(f3,s);
writeln(s) end;
close(f3); readln
end.
12.Описание
: Очистить файл, оставив только первую строчку.
program one;
uses crt;
var fl1:text;a:string;i,l,poz:longint;label m;
begin clrscr;
assign(fl1,’input.txt’);
reset(fl1); readln(fl1,a); close(fl1);
l:=length(a);
rewrite(fl1);
for i:=1 to l do if a[i]=’.’then begin poz:=i;goto m; end;
m:for i:=1 to poz do write(fl1,a[i]); close(fl1);
writeln(‘complete!!!’);
readkey;
end.
13.Описание
: Вывод статистики по файлу
program one; uses crt; var infile:text;file_name,s:string;i, commas, points, blanks,lines:integer; begin clrscr; commas:=0;points:=0;blanks:=0;lines:=0; write(‘vvedite imya faila’); readln(file_name); assign(infile,file_name);reset(infile); while not eof(infile) do begin readln(infile,s); for i:=1 to length(s) do begin case s[i] of ‘,’ :inc(commas); ‘.’ :inc(points); ‘ ‘ :inc(blanks); end; end; inc(lines); end; close(infile); gotoxy(1,3); writeln(‘zapyatih: ‘,commas); writeln(‘predlogenii: ‘,points); writeln(‘ probelov: ‘,blanks); writeln(‘ strok: ‘,lines); readln; end.
14
Задан файл F, компонентами которого являются целые числа. Переписать в файл G сначала все отрицательные, потом все нулевые, а потом все положительные числа, упорядочив их по возрастанию модуля величины. файл
G —
текстовый
.
Program Pascal; Const fname=’num.txt’; fname2=’num2.txt’; Var f,g:text; stroka:string; k,code,i,j,tmp:integer; a:array[1..20] of integer; begin Assign(F, fName); ReSet(F); k:=0; While Not Eof(F) Do Begin ReadLn(F, Stroka); k:=k+1; val(Stroka,tmp,code); a[k]:=tmp; writeln(a[k]); End; close(f); writeln; writeln(k); writeln; for i:=2 to k do for j:= k downto 2 do if a[j-1] > a[j] then begin tmp := a[j-1]; a[j-1] := a[j]; a[j] := tmp; end; for i:=1 to k do write(a[i],’ ‘); Assign(g, fName2); rewrite(g); for i:=1 to k do begin writeln(g,a[i]); end; close(g); writeln; readln; end.
15
Задан тектовый файл, содержащий текст. Найти сколько раз встречается в нем самое длинноватое слово.
program
tp7; const razd=[‘ ‘,’.’,’,’,’?’,’!’,’:’,’)’,'(‘]; var f:text; s,slo,slovo,name:string; k,i:integer; begin write(‘Введите имя файла:’); readln(Name); assign(f,name); reset(f); slovo:=»;k:=0; while not(EOF(F)) do begin readln(f,s);slo:=»; for i:=1 to length(s) do begin if s[i] in razd then begin if (i>1)and not(s[i-1]in razd) then begin if (length(slo)=length(slovo))and (slo=slovo) then k:=k+1; if length(slo)>length(slovo) then begin slovo:=slo; k:=1 end; end; slo:=» end else begin slo:=slo+s[i] end; end; if (length(slo)=length(slovo))and (slo=slovo) then k:=k+1; if length(slo)>length(slovo) then slovo:=slo; end; writeln(‘слово ‘,slovo,’ встречается ‘,k,’ раз’); close(f); readln end.
Раздел: Записи
1.Описание: В файл вводятся имена, пол и рост человека. программка считывает данные из файла и выдает совпадения, если в нем есть мужчины 1-го роста.
program one;
const n=2;
type group=record
ser:string[30]; p:string[1]; h:100..250;
end;
var person:array[1..n] of group; f:text; r:boolean; ar:array[1..n] of integer; i,j,z,obr:integer;
begin assign(f,’AAAAAAA.txt’);
rewrite(f);
for i:=1 to n do with person[i] do begin writeln(‘person ‘,i);
writeln(f,’person ‘,i);
writeln(‘sername’);
readln(ser);
writeln(f,’sername: ‘,ser,’ ‘);
writeln(‘pol’);
readln(p);
writeln(f,’pol: ‘,p,’ ‘);
writeln(‘rost’);
readln(h);
writeln(f,’rost: ‘,h,’ ‘);
writeln(f);
writeln; end;
close(f);
reset(f);
append(f);
writeln(f,’poisk dvuh men s odinakovim rostom’);
j:=1; for i:=1 to n do begin with person[i] do begin if (p=’m’) or (p=’M’) then begin ar[j]:=h;
j:=j+1; z:=j-1; end; end; end;
r:=false;
for j:=1 to z do begin obr:=ar[j]; i:=j;
repeat if ar[i+1]=obr then r:=true else i:=i+1;
until (i>z) or (r); end;
if r=true then writeln(f,’sovpadenie naydeno’);
if r=false then writeln(f,’sovpadenie ne naydeno’);
close(f);
readln;
end.
2.Описание
: Телефонный справочник
program one; type Zapis=record fam:string; tel:string;
end; var out: file of Zapis; nam:Zapis; kon:char; begin assign(out,’nomera’); rewrite(out); repeat write(‘fam?’); readln(nam.fam); write(‘nomer?’); readln(nam.tel); write(out,nam); writeln(‘prodolgim? y/N’); readln(kon); until kon <>’y’; reset(out); while not eof(out) do begin read(out,nam); writeln(nam.famactiveXnam.tel); end; close(out); end.
3.Описание: Программка, которая делает файл с описанием студентов:
program one;
type TStudentInfo=record name:string[30]; kurs:string[20]; ekz:array[1..5] of byte; end; var f:file of TStudentInfo; st:TStudentInfo; p:byte; begin assign(f,’students.dat’); reset(f); {Откроем файл. Позиция сейчас в самом начале} if ioresult<>0 then rewrite(f); {Если ошибка, занчит файла нет, и означает откоем его подругому} seek(f,filesize(f));
with st do repeat write(‘Введите имя студента (пустую строчку для выхода): ‘); readln(name); if name=» then break; write(‘Введите курс:’); readln(kurs); for p:=low(ekz) to high(ekz) do begin write(‘Введите оценку по экзамену №’,p,’: ‘); readln(ekz[p]); end; write(f,st); {Вот эта строчка и записывает информацию о студенте в файл} until false; close(f); {Эту команду мы ещё не разглядывали, но о этом я расскажу в конце} end.
4.Описание: Делается ввод даты поочередно: число, месяц, год. программка инспектирует наличие ошибок при вводе.
program lab4;
uses crt;
type day=1..31; mon=1..12; year=1..3000;
var data:record
d:day; m:mon; y:year; end; s:boolean;
function vernaydat:boolean;
begin with data do begin write(‘chslo: ‘);
readln(d);
write(‘mesyc: ‘);
readln(m);
write(‘god: ‘);
readln(y);
s:=true;
if y>3000 then s:=false;
if m>12 then s:=false;
case m of 1,3,5,7,8,10,12:begin if d>31 then s:=false; end;
4,6,9,11:begin if d>30 then s:=false; end;
2:begin if (y mod 4)<>0 then if d>28 then s:=false;
if (y mod 4)=0 then if d>29 then s:=false;
end; end;
if s=true then write(‘OK’);
if s=false then write(‘ERROR’);end;end;
begin clrscr;
writeln(‘Vvedite datu’);
Vernaydat; readln;
end.
5.Описание: Формирование базы данных инфы о студентах. Вывод из таблицы перечень студентов:-получивших оценку 4;-получивших оценки 4 и 5;-фамилия которых начинается на ‘А’.
Program Laba6;
Uses Crt;
Type Exam = Record
Name: String[20]; Year: Integer; Lesson: String[10]; Prise: Integer;
End;
Mass = Array [1..30] Of Exam;
Var Student: Mass; Prise1, Prise2, Num, I: Integer; Letter: Char;
Procedure InputStudent (Var InpNum: Integer);
Var I:Integer;
Begin ClrScr;
Write (‘4islo studentov: ‘);
ReadLn (InpNum);
For I:=1 To InpNum Do Begin Write (‘vvvedite familiyu stud nomer ‘,I,’ [20] : ‘); ReadLn (Student[I].Name);
Write (‘god rojden stud nomer’,I,’: ‘); ReadLn (Student[I].Year);
Write (‘predmet studenta nomer ‘,I,’ [10] : ‘); ReadLn (Student[I].Lesson);
Write (‘ocenka stud nomer ‘,I,’: ‘); ReadLn (Student[I].Prise);
WriteLn; End;End;
Procedure OutLine (Line: Integer);
Begin Write (Student[Line].Name:20);
Write (Student[Line].Year:6);
Write (Student[Line].Lesson:10);
Write (Student[Line].Prise:7);
WriteLn;End;
Procedure OutStudent (OutNum: Integer); Var I: Integer;
Begin ClrScr;
WriteLn (‘familiya’:20,’god’:6,’predmet’:10,’ocenka’:7);
For I:=1 To OutNum Do OutLine (I);End;
Procedure OutStudentPrise1 (OutNum, OutPrise: Integer);Var Col, I: Integer;
Begin WriteLn;
Col:=0;
WriteLn (‘dannye o stud-h polu4ivshih ocenki: ‘,OutPrise);
For I:=1 To OutNum Do If (Student[I].Prise=OutPrise) Then Begin Col:=Col+1;
OutLine (I); End;
WriteLn (‘4islo stud polu4ivshih ocenku ‘,OutPrise,’: ‘,Col);End;
Procedure OutStudentPrise2 (OutNum, OutPrise1, OutPrise2: Integer);
Var I: Integer;
Begin WriteLn;
WriteLn (‘dannye o stud polu4ivshih ocenku : ‘,OutPrise1,’ Ё ‘,OutPrise2);
For I:=1To OutNum Do If ((Student[I].Prise=OutPrise1)Or (Student[I].Prise=OutPrise2))Then OutLine (I);
End;
Procedure OutStudentName (OutNum:Integer; OutLetter:Char);Var I: Integer;
Begin WriteLn;
WriteLn (‘dannye o studentah 4i familii na4inayutsa na «‘,OutLetter,'»‘);
For I:=1 To OutNum Do If (Copy(Student[I].Name,1,1)=OutLetter)Then OutLine (I);End;
Begin InputStudent (Num);
OutStudent (Num); Prise1:=4;
OutStudentPrise1 (Num, Prise1); Prise2:=5;
OutStudentPrise2 (Num, Prise1, Prise2); Letter:=’Ђ’;
OutStudentName (Num, Letter);
ReadLn;
End.
6.Описание: Дана таблица материалов с последующей информацией по любому материалу: заглавие, удельный вес, вид проводимости (диэлектрик, полупроводник, проводник). Выписать из таблицы все полупроводники и их удельный вес.
program one;
Uses CRT;
Const Veshestvo = 1;
Type Material = Record
Name: String[20]; Weight: Real; Provod: Integer;
End;
Var Result,I,J,N: Integer; F : Array[1..20] Of Material; Begin
F[1].name := ‘med’; F[1].Weight := 4.00; F[1].Provod := 2;
F[2].name := ‘bumaga’; F[2].Weight := 66.0; F[2].Provod := 0;
F[3].name := ‘ЉаҐ¬Ё©’; F[3].Weight := 5.40; F[3].Provod := 1;
F[4].name := ‘germany’; F[4].Weight := 21.5; F[4].Provod := 1;
F[5].name := ‘arsenid gallia’; F[5].Weight := 3.00; F[5].Provod := 1;
F[6].name := ‘alluminiy’; F[6].Weight := 50.0; F[6].Provod := 2;
F[7].name := ‘keramika’; F[7].Weight := 9.90; F[7].Provod := 0;
F[8].name := ‘rezina’; F[8].Weight := 80.0; F[8].Provod := 0;
F[9].name := ‘ftoroplast’; F[9].Weight := 4.00; F[9].Provod := 0;
ClrScr;
N := 9;
Result := 0;
Writeln(‘naimenovanie materiala udelny ves provodimost’);
Writeln(‘————————————————————‘);
For I := 1 to N Do If (F[I].Provod = Veshestvo) Then Begin
Write(F[I].Name:22,F[I].Weight:15:2);
Case F[I].Provod Of
0: WriteLn(‘izolyator’:15);
1: WriteLn(‘poluprovodnik’:15);
2: WriteLn(‘provodnik’:15); End;
Result := Result + 1; End;
Writeln(‘————————————————————‘);
Writeln(‘naideno ‘,Result,’ material.’);
If Result = 0 Then WriteLn(‘takogo materiala net’); Readln;
End.
7.Описание: Вывести из введеной строчки слова с наибольшим количеством вхождений буквл ‘l’ и ‘o’ и подсчитать количество этих вхождений.
Type Info = record
wrd,num : Byte; ch : Char;
End;
Var S, Temp:String; P,I : Byte; M, N : Info;
Function CalkChar(A:String;C:Char):Byte; Var I, Result : Byte;
Begin Result := 0;
For I := 1 To Length(A) Do If UpCase(A[I]) = UpCase(C) Then Inc(Result);
CalkChar := Result;
End;
Begin WriteLn(‘vvedite frazu po-angl:’);
ReadLn(S);
I := 1;
M.num := 0; M.wrd := 0; M.ch := ‘l’;
N.num := 0; N.wrd := 0; N.ch := ‘o’;
While Pos(‘ ‘,S) <> 0 Do Begin P := Pos(‘ ‘,S);
Temp := Copy(S,1,P);
If M.wrd < CalkChar(Temp,M.ch) Then Begin M.num := I;
M.wrd := CalkChar(Temp,M.ch); End;
If N.wrd < CalkChar(Temp,N.ch) Then Begin N.num := I;
N.wrd := CalkChar(Temp,N.ch); End;
Delete(S,1,P); Inc(I); End;
If M.wrd < CalkChar(S,M.ch) Then Begin M.num := I;
M.wrd := CalkChar(S,M.ch); End;
If N.wrd < CalkChar(S,N.ch) Then Begin N.num := I;
N.wrd := CalkChar(S,N.ch); End;
WriteLn(‘————-‘);
If M.wrd <> 0 Then WriteLn(‘bukva ‘,M.ch,’4asche vstre4aetsa v ‘,M.num,’-¬ slove, celyh ‘,M.wrd,’ raz( )’);
If N.wrd <> 0 Then WriteLn(‘bukva ‘,N.ch,’ 4asche vstre4aetsa v ‘,N.num,’-m slove, celyh ‘,N.wrd,’ raz( )’);readln;
End.
8.Описание: Из начальной таблицы игрушек с полями: заглавие игрушки, стоимость, возрастные ограничения, выписать сведения для игрушек стоимостью наименее 4 рублей, пригодные детям 5 лет.
Uses CRT;
Const Vozrast = 5;
Cena = 400;
Type Toy = Record
Name: String[20]; Sale: Integer; Min: Integer; Max: Integer;
End;
Var Sum,Result,I,J,N: Integer; F : Array[1..20] Of Toy;
Begin
F[1].name := ‘mya4’; F[1].Sale := 400; F[1].min := 1; F[1].max := 9;
F[2].name := ‘kukla’; F[2].Sale := 660; F[2].min := 3; F[2].max := 7;
F[3].name := ‘samolet’; F[3].Sale := 540; F[3].min := 3; F[3].max := 5;
F[4].name := ‘pupsik’; F[4].Sale := 210; F[4].min := 1; F[4].max := 3;
F[5].name := ‘knijka’; F[5].Sale := 300; F[5].min := 1; F[5].max := 5;
F[6].name := ‘mashinka’; F[6].Sale := 500; F[6].min := 3; F[6].max := 8;
F[7].name := ‘parovoz’; F[7].Sale := 990; F[7].min := 4; F[7].max := 7;
F[8].name := ‘ula’; F[8].Sale := 800; F[8].min := 2; F[8].max := 5;
F[9].name := ‘konstruktor’; F[9].Sale := 400; F[9].min := 6; F[9].max := 9;
ClrScr;
N := 9;
Result := 0;
Sum := 0;
Writeln(‘igryshka cena, kop. Min vozrast Max vozrast’);
Writeln(‘————————————————————‘);
For I := 1 to N Do If (F[I].min <= Vozrast) And (Vozrast <= F[I].max) And (F[I].Sale <= Cena) Then Begin
WriteLn(F[I].Name:20,F[I].Sale:12,F[I].Min:14,F[I].Max:13);
Result := Result + 1; Sum := Sum +F[I].Sale; End;
Writeln(‘————————————————————‘);
Writeln(‘stoimost pokupki: ‘,Sum/100:3:2,’ rub.’);
If Result = 0 Then WriteLn(‘pokupku sovershit nevozmojno!’);
Readln;
End.
9.Описание: Из первой таблицы, где заданы коэффициенты для уравнений задания линий выписать в новейшую таблицу лишь те коэффициенты, которые сформировывают линию, параллельную первой в начальной таблице.
Uses CRT;
Type Line = Record
A,B,C: Integer;
End;
Var Result,I,J,N: Integer; F,G : Array[1..20] Of Line;
Begin
F[1].A := 1; F[1].B := 9; F[1].C := 2;
F[2].A := 2; F[2].B := 6; F[2].C := 3;
F[3].A := 3; F[3].B := 5; F[3].C := 1;
F[4].A := 4; F[4].B := 2; F[4].C := 4;
F[5].A := 3; F[5].B := 3; F[5].C := 1;
F[6].A := 2; F[6].B := 5; F[6].C := 2;
F[7].A := 1; F[7].B := 9; F[7].C := 5;
F[8].A := 2; F[8].B := 6; F[8].C := 1;
F[9].A := 3; F[9].B := 5; F[9].C := 2;
ClrScr;
N := 9; Result := 0; I := 1;
For J := 2 to N Do If (F[I].A = F[J].A) And (F[I].B = F[J].B) Then Begin Write(‘liniya ‘,I,’ paralelna linii ‘,J,’ ‘);
WriteLn(F[I].A,’X + ‘,F[I].B,’Y + ‘,F[I].C);
Result := Result + 1; End;
Writeln(‘naideno ‘,Result,’ liniy’);
If Result = 0 Then WriteLn(‘takih liniy net’);
Readln;
End.
10.Описание: Имеется запись о багаже пассажира (кол-во вещей и общий вес вещей). Узнать, имеется ли пассажир, багаж которого превосходит багаж всякого из других пассажиров и по числу вещей и по весу. Отдать сведения о багаже, число вещей в каком не меньше, чем в любом другом багаже, а вес вещей не больше, чем в любом другом багаже.
uses crt; type bagaj = record ves:double;kol_veshei: integer; end; var bagage:array[1..20] of bagaj; i,j,n,temp:byte;rez,k:double;a:boolean; begin clrscr; writeln(‘Vvedite kol-vo passajirov (n <= 20):’); readln(n); for i:=1 to n do begin writeln(‘Vvedite svedeniya o ‘,i,’-om bagaje passajira:’); writeln(‘Vvedite ves bagaja: ‘); readln(bagage[i].ves); writeln(‘Vvedite kol-vo veshei bagaja: ‘); readln(bagage[i].kol_veshei);end; clrscr; writeln(‘Bagage, sredniy ves odnoi veshi otlichaetsya ne bolee’); writeln(‘chem na 0.3 kg ot obshego srednego vesa:’); writeln; a:=true; for i:=1 to n do begin rez:=bagage[i].ves/bagage[i].kol_veshei; if (абс(bagage[i].ves — rez) <= 0.3) then begin a:=false; writeln(‘Bagage nomer ‘,i); writeln(‘ves bagaja: ‘,(bagage[i].ves):5:2,’ kg’); writeln(‘kol-vo veshei: ‘,bagage[i].kol_veshei);writeln; end;end; if (a) then writeln(‘Takogo bagaja net!’); writeln; writeln(‘Kol-vo passajirov imeyushih bolee 2 veshei:’); writeln; temp:=0; for i:=1 to n do if (bagage[i].kol_veshei > 2) then temp:=temp+1; writeln(‘Takih passajirov ‘,temp,’ chelovek’); if temp = 0 then writeln(‘Takih passajirov net!’); writeln; writeln(‘Kol-vo veshei bolshe srednego chisla veshei: ‘); writeln; rez:=0; temp:=0; for i:=1 to n do rez:=rez+bagage[i].kol_veshei; for i:=1 to n doif (bagage[i].kol_veshei > (rez/n)) then temp:=temp+1; writeln(‘Takih veshei ‘,temp); if temp = 0 then writeln(‘Takih veshei 0’);.writeln; writeln(‘Bagage iz 1 veshi s vesom ne menee 30 kg’); writeln; temp:=0; for i:=1 to n doif bagage[i].kol_veshei = 1 thenif bagage[i].ves >= 30 thentemp:=temp+1; writeln(‘Imeetsya ‘,temp,’ passajirov s takim bagajom’); readln; end.
11.Описание: 1.Перечень книжек состоит из 10 записей. Запись содержит поля: Фамилия создателя, заглавие книжки, год издания.Отыскать заглавие книжек данного создателя, изданных с 1960 года.
Program df; Uses crt; Type knigi= record Fam:string[15];Naz:string[30];Gad:integer; End; Var s:array[1..10] of knidi; I,k:integer;Av:string;Begin clrscr; For i:=1 tio 10 do begin with s[i] do begin Writeln(vvedi fam,i); Readln(fam); Writeln(vvedi nazv,i); Readln(nazv); Writeln(god); Readln(god);End;end; Writeln(vvedi av); Readln(avt); K:=length(av); For i:=1 to 10 do begin With s[i] do begin If (copy(fam,1,k)=av) and (god>1960) then writeln(nazv,nazv); End;End; End.
12.Описание:
Из ведомости 3-х студентов с их оценками ( порядковый номер, Ф.И.О. и три оценки) найти количество отличников и средний бал всякого студента.
Program Spic; Type wed = record n:integer ; fio:string[40] ; bal:array [1..3] of integer end;Var spisok:wed; i,j,kol,s:integer; sr:real; Begin kol:=0; with spisok do For i:=1 to 3 do begin n:=i; Write (‘ Vvedite FIO # ‘, i ,’ ‘); Readln (fio); s:=0; For j:= 1 to 3 do begin write ( ‘Vvedite ocenky: ‘ ); readln ( bal [j] ); s := s+ bal [j]; end; if s=15 then kol:=kol+1; sr := s/3; writeln ( fio, ‘, Sredniy bal = ‘, sr:4:1); end; writeln ( ‘ Kolichestvo otlichnikov = ‘, kol ); readln; end.
13.Описание: программка указывает пример объединения координат точек в запись. тут употребляется массив из записей типа RecPoint. Любая таковая запись содержит внутри себя поля с координатами x, y, z и поле комментария. Таковым образом, одна запись обрисовывает одну точку, а массив из записей представляет собой набор точек.
Program Records; Uses crt; type RecPoint = record x, y, z: real; comment: string end; var
14.Описание: Сглаживание текста
uses crt;
const
l = 79; {kolvo liter, umeshayushihsya na ekrane v DOSe}
var t: text; i, j: integer; s: string; c, ost: byte;
begin clrscr;
assign(t, ‘input.txt’); reset(t);
while not EoF(t) do begin readln(t, s);
for i := 1 to length(s) do if s[i] = ‘ ‘ then incc;
ost := l — length(s); {ost — kolichestvo probelov, kotorie nado}
j := 1;
while ost > 0 do begin for i := 1 to length(s) + c — 1 do if (s[i] = ‘ ‘) then begin if ost <= 0 then break;
insert(‘ ‘, s, i); dec(ost); inc(i, j); end;
inc(j); {t.k. pri prohozhdenii cikla FOR mi vstrechaem pervii probel} end;
c := 0; {obyazatel’no obnulayem kol-vo strok v stroke}
writeln(s); end;
close(t); readkey;
end.
15.Описание:программка контроля студентов по литературе.Формируется файл вопросцев и ответов
program zavd1;
uses crt;
const qfile=’quest.txt’; afile=’ansver.txt’; var f1,f2:text;i,k:integer; name,ansv:string;
begin clrscr;
assign(f1,qfile);
assign(f2,afile);
rewrite(f2);
reset(f1);
write(‘vvedi imya ?¬`п, gruppu :’);
readln(name);
writeln(f2,name);
while not eof(f1) do begin readln(f1,name);
writeln(name);
write(‘‚ и ў?¤Ї®ў?¤м :’);
readln(name);
writeln(f2,name);
readln(f1,ansv);
if ansv=name then k:=k+1;
i:=i+1;end;
writeln(f2,’‚бм®Ј® ЇЁв м :’);
writeln(f2,i);
writeln(f2,’Џа ўЁ«мЁе ЇЁв м :’);
writeln(f2,k);
close(f1); close(f2);
end.
Раздел: Строчки
1. Описание:
Из строчки циклических слов, отделяемых запятыми и заканчивающиеся точкой, выписать все гласные буковкы в алфавитном порядке, которые входят не наиболее чем в одно слово.
program one;
Uses CRT;
Type MyType = Set Of Char; Var S,W : String; I,K,L : Integer; J : Char; M,N : MyType; B,C : Array [1..32] of MyType;
Begin ClrScr;
M :=[‘ ‘,’Ґ’,’с’,’Ё’,’®’,’г’,’л’,’н’,’о’,’п’]; S := ‘е«ҐЎ,¬®«®Є®, аЎг§,алЎ ,ᥫҐ¤Є .’; K := 1;
writeln(s);
While pos(‘,’,S) > 0 Do Begin W := copy(S,1,pos(‘,’,S));
B[K] := [];
For I := 1 To Length(W) Do B[K] := B[K] + [W[I]];
Inc(K);
delete(S,1,pos(‘,’,S)); End;
W := S; B[K] := [];
For I := 1 To Length(W) Do B[K] := B[K] + [W[I]];
For I := 1 To K Do Begin C[I] := B[I]; For L := 1 To K Do If I <> L Then C[I] := C[I] — B[L]; End;
N := [];
For I := 1 To K Do N := N + C[I];
M := M * N;
For J := ‘ ‘ To ‘п’ Do If J in M Then Write(J,’ ‘);
WriteLn; ReadKey;
End.
2.Описание: база метода игры, согласно которой из слова эталона, которое является первым в строке (в данном случае
Pascal
), составляются остальные слова из тех же букв. количество вхождений одной и той же буковкы обязано быть не больше, чем в образчике.
program one;
Uses CRT;
Var S,T : String; N,I,J : Integer; A : Array [1..100] of String; F : Boolean;
Begin ClrScr;
S := ‘pascal cal lasca nosok pasca sapca lapca caplan capla’;
N := 1;
While pos(‘ ‘, S) > 0 Do Begin A[N] := copy(S, 1, pos(‘ ‘, S)-1);
delete(S, 1, pos(‘ ‘, S));
inc(N); End;
A[N] := S;
For I := 2 To N Do Begin F := True;
T := A[I];
For J := 1 To Length(T) Do Begin If (pos(T[J], A[1])) >0 Then T[JactiveXElse F := False; End;
If F Then WriteLn(A[I]); End;
readln;
End.
3.Описание: Вывести каждое слово предложения задом наперед.
Program Stroki;
const chars=[‘.’,’,’,’!’,’?’,’ ‘];var S,S_out,slovo: string; i,j: integer;
begin Writeln(‘Vv stroku’);
Readln(S);
S:= S+’ ‘;
for i:= 1 to Length(S) do if not (S[i] in chars) then Slovo:=slovo+S[i] else if slovo <> » then begin for j:= Length(slovo) downto 1 do S_out:=s_out+slovo[j];
s_out:=s_out+’ ‘;
slovo:=»; end;
Writeln(S_out);
Readln;
end.
4.Описание: Расположить слова в порядке возрастания их длины в тексте.
program one;
uses crt;
var a,d,sl1,sl2 : string; i,l,k,j : longint; b : array [1..50] of string;
begin clrscr;
write(‘input s: ‘);readln(a);l:=length(a);
if a=»then halt;
if a[l]<>’ ‘ then begin inc(l);a[l]:=’ ‘; end;
for i:=1 to l do if a[i]=’ ‘then begin inc(j);b[j]:=d;d:=»; end else d:=d+a[i];
for i:=1 to j-1 do for k:=i+1 to j do begin sl1:=b[i]; sl2:=b[k];
if length(sl1)>length(sl2) then begin b[i]:=sl2; b[k]:=sl1; end; end;
for i:=1 to j do write(‘ ‘,b[i]); readln;
end.
5.Описание: Отыскать и поменять определенные знаки в тексте (заменяемые) введенным эмблемой с клавиатуры (заменяющий). Каждую
подмену
аккомпанировать
доказательством
.
program one;
uses crt;
var i,l:longint;a,a1,a2,p:string;
begin clrscr;textcolor(11);
write(‘vvedite text: ‘); readln(a);
write(‘zamenyaemyi simvol: ‘); readln(a1);
write(‘zamenyauschiy simvol: ‘); readln(a2);
if (length(a1)>1)or(length(a2)>1) then halt;l:=length(a);
for i:=1 to l do if a[i]=a1 then begin clrscr; a[i]:=’_’;
writeln(a);
writeln(‘Vy podtverzhdaete zamenu ‘,i,’-ogo simvola? (y/n)’); readln(p);
if p=’y’ then a[i]:=a2[1] else a[i]:=a1[1]; end;
clrscr;
write(a); readln;
end.
6.Описание: Отыскать схожее слово в предложении, которое различается не наиболее, чем на два знака. Пример
: Pascal=Paskal=Pacsal.
program one;
var s,sl:string; m:array[1..100] of string; i,j,k,p,n,kol:integer;
beginwrite(‘Vvedite TEXT (slova cerez PROBEL): ‘); readln(s);
write(‘ISCEM — ? : ‘); readln(sl);
i:=0;
repeat inc(i);
p:=pos(‘ ‘,s);
m[i]:=copy(s,1,p-1);
delete(s,1,p);
until p=0; n:=i; m[n]:=s;
writeln(‘Naideno:’);writeln;
for i:=1 to n do begin kol:=0;
for j:=1 to length(sl) do if pos(sl[j],m[i])<>0 then inc(kol);
if (length(m[i])-kol)<3 then writelnactiveXm[i]); end; readln;
end.
7.Описание: Подсчет числа слов в тексте.
program one;
uses crt;
var tec : string; l,i,n : longint;
begin clrscr;
write(‘input s:’);readln(tec);
l:=length(tec)+1;tec[l]:=’ ‘;
for i:=1 to l do if tec[i]=’ ‘then n:=n+1;
write(‘in s ‘,n,’ words’);
readln;
end.
8.Описание: Наибольшее слово в прдложении
program one;
Uses CRT;
Var MaxL,C : String; Pb : Byte;
Begin ClrScr;
WriteLn(vvedite predlojenie:’); ReadLn(C);
MaxL := »;
While Pos(‘ ‘,C) <> 0 Do Begin Pb := Pos(‘ ‘,C);
If Length(MaxL) < Length(Copy(C,1,Pb-1)) Then MaxL := Copy(C,1,Pb-1);
Delete(C,1,Pb); End;
If Length(MaxL) < Length(C) Then MaxL := C;
WriteLn;
WriteLn(‘Samaya bolshayaposledovatelnost’simvolov v predlojenii:’);
WriteLn(MaxL);
ReadLn;
End.
9.Описание: Выписать слова из строчки, которые начинаются с данной буковкы.
program one;
uses crt;
var a,aa,b : string; i,l,o,oo : longint;
begin clrscr;
write(‘string: ‘);readln(a);
write(‘bukva: ‘);readln(aa);l:=length(a);
if length(aa)>1 then halt;
if a[l]<>’ ‘then begin inc(l);a[l]:=’ ‘; end;
for i:=1 to l do if a[i]=’ ‘then begin if b[1]=aa then writeln(b) else inc(o);inc(oo);b:=»;
end else b:=b+a[i];
if o=oo then write(‘takix slov net!’); readln;
end.
10.Вводится 10 букв, а потом слово. Проверяется возможность составить введенное слово из этих знаков.
program one;
uses crt;
var as:Array[1..10]of Char; s,s2:String; i,b:Byte;
beginclrscr;
Writeln(‘vvedite 10 simvolov:’);
for i:=1 to 10 do begin rite(‘ь’,i,’: ‘);
readln(mas[i]); end;
write(‘vvedite stroku: ‘); readln(s);
for i:=1 to Length(s) do for b:=1 to 10 do if s[i]=mas[b] then begin s2:=s2+mas[b];
mas[b]:=’ ‘; b:=10; end;
if s2=s then write(‘Iz etih simvolov mozhno sostavit’ slovo ‘,s)else writeln(‘Iz etih simvolov nelzya sostavit slovo’,s);
readln;
end.
11.Описание:Отыскать в строке малое и наибольшее слова
program gdy;
label 1;
var s:string; m:array[1..100] of string; i,p,n:integer; ax,min:string; c:char;
begin 1:write(‘Vvedite stroky: ‘); readln(s);
if s[length(s)]<>’.’ then begin writeln(‘ERROR: konec stroki okancivaetsia na «.»‘); goto 1; end;
if length(s)>79 then begin writeln(‘ERROR: stroka doljna biti <=79 simvolov’); goto 1; end;
write(‘Vvedite ZADANII SIMVOL:’); readln(c);
i:=0;
repeat p:=pos(‘ ‘,s);
if pos(c,copy(s,1,p-1))<>0 then begin inc(i); m[i]:=copy(s,1,p-1); end; delete(s,1,p); until p=0; n:=i; f pos(c,copy(s,1,length(s)-1))<>0 then begin n:=i+1; m[n]:=copy(s,1,length(s)-1); end;
max:=m[1]; min:=m[1];
for i:=2 to n do begin if length(m[i])>length(max) then max:=m[i];
if length(m[i])<length(min) then min:=m[i]; end;writeln;
writeln(‘MakS: ‘,max);
writeln(‘MIN: ‘,min);
readln; readln;
end.
12.Описание: Счет количества вхождений всякого знака в строчку.
program one;
Var I : Word; M : Array [0..255] Of Byte; S : String;
Begin For I := 0 To 255 Do M[I] := 0;
writeln(‘input string’);
Readln(S);
For I := 1 To Length(S) Do Begin Inc(M[ORD(S[I])]); End;
For I := 0 To 255 Do Begin If M[I] > 0 Then WriteLn(CHR(I):3, M[I]:3); End; readln;
End.
13.Описание: Удаление пробелов из данной строчки и вывод результата.
program one;
Var S,T : String; I : Integer;
Begin writeln(‘input string’);
readln(s);
T := »;
For I := 1 To Length(S) Do Begin If (S[I] <> ‘ ‘) Then T := T + S[I];
End;
WriteLn(T);
ReadLn;
End.
14.Описание: Вывести данный знак данное количество раз
program one;
uses crt;
var n:byte; l:string;n function zvezda(n:byte;l:string):real; var i:integer; s:string;
begin i:=1;
s:=»;
while i<=n do begin s:=s+l;
inc(i); end;
writeln(s); end;
begin clrscr;
writeln(‘Vvedite chislo’); readln(n);
writeln(‘Vvedite simvol’); readln(l);
zvezda(n,l);
readkey;
end.
15.Описание: Поменять строчку звездочками, если строчка содержит кавычки
Program one;
var S : string; i : integer;
found : boolean;
begin Write(‘vvedite stroku simvolov : ‘);
Readln(S); Found := FALSE;
for i := 1 to Length(S) do {Length(s) = длинна строчки, обычная функция}
if s[i] = »» then found := TRUE; if Found then {если найден знак «»,заменяем}
for i := 1 to Length(S) do s[iactiveXWriteln(‘Rezultiruyuschaya stroka: ‘, S);
readln;
end
Раздел: Графика
1.Описание:
Зеленоватый перевернутый лист папоротника, заполняющийся точками.
program Fract;
uses Graph,Crt;
var Dt,M : integer; R,A,B,C,D,E,F, NewY,NewX,X,Y : real;
begin Dt := Detect;
InitGraph(Dt, M,»);
Randomize;
X := 0; Y := 0;
repeat R := Random;
if R>0.93 then begin A := -0.15; B := 0.28; C := 0.26; D := 0.24; E := 0; F := 0.44;
end else if R>0.86 then begin A := 0.2; B := -0.26; C := 0.23; D := 0.23; E := 0; F := 1.6;
end else if R>0.01 then begin A := 0.85; B := 0.02; C := -0.02; D := 0.85; E := 0; F := 1.6;
end else begin A := 0; B := 0; C := 0; D := 0.16; E := 0; F := 0; end;
NewX := A*X + B*Y + E; NewY := C*X + D*Y + F; X := NewX; Y := NewY;
PutPixel(Round(X*50)+100,Round(Y*50)+50, Green);
until(Keypressed);
CloseGraph;
end.
2.Описание: Стрелочные часы с быстроидущей секундной стрелкой и показом настоящего времени.
Program 4as;
uses graph, crt, dos;
type TPoint = record
x, y: Real; end;
var H, M, S, Hund : Word; Xc, Yc, i : Integer; P, P2, P3, P4, P5, P6 : TPoint;
procedure Dec2Polar(Ang, Len: Real; var P: TPoint);
begin Ang := Ang — 90; { Correlation for our coord system }
P.x := Xc + Len * cos(Ang * Pi / 180);
P.y := Yc + Len * sin(Ang * Pi / 180);end;
begin i := 0;
InitGraph(i, i, »);
Xc := GetMaxX div 2; Yc := GetMaxY div 2; SetColor(10);
Circle(Xc, Yc, Yc — 30); SetColor(2); Circle(Xc, Yc, 3); SetColor(14);
for i := 0 to 23 do begin Dec2Polar(i * 15, Yc — 40, P);
Circle(Round(P.x), Round(P.y), 2 + 3*Byte(i mod 2 = 0)); end;{ SetLineStyle(0, 0, 3);}
while not keypressed do begin { Erase } SetColor(0); Line(Round(P2.x), Round(P2.y), Round(P.x), Round(P.y));
Line(Round(P4.x), Round(P4.y), Round(P3.x), Round(P3.y));
Line(Round(P6.x), Round(P6.y), Round(P5.x), Round(P5.y));
GetTime(H, M, S, Hund); { Second arrow }
Dec2Polar((S + Hund/100) * 6, Yc — 50, P);
Dec2Polar((S + Hund/100) * 6, 5, P2); { Minute arrow }
Dec2Polar((M + S/60) * 6, Yc — 100, P3);
Dec2Polar((M + S/60) * 6, 5, P4); Dec2Polar((H + M/60) * 30, Yc — 150, P5);
Dec2Polar((H + M/60) * 30, 5, P6); { Redraw } SetColor(15);
Line(Round(P2.x), Round(P2.y), Round(P.x), Round(P.y)); SetColor(9);
Line(Round(P4.x), Round(P4.y), Round(P3.x), Round(P3.y)); SetColor(7);
Line(Round(P6.x), Round(P6.y), Round(P5.x), Round(P5.y)); delay(1000); end; CloseGraph;
end.
3.Описание:
Скачущий мяч с постепенным понижением амплитуды.
program ufo;
uses crt,graph; const r=20;h=5; var gd,gm,i,n,t,x,y,p:integer;
begin clrscr;
gd:=Detect;
initgraph(gd,gm,’c:bpbgi ‘); setcolor(4); setlinestyle(0,1,1);
line(0,479,639,479);
x:=r;y:=r; t:=479-2*r; n:=t div h; p:=h;
while n<>0 do begin for i:=1 to n do begin setcolor(2); circle(x,y,r); setfillstyle(1,2);
floodfill(x,y,2); delay(10);
setcolor(0); circle(x,y,r);
setfillstyle(1,0); floodfill(x,y,0);
y:=y+p; x:=x+1; end;
if p>0 then begin t:=round(3*t/4);n:=t div h end;
p:=-p end; setcolor(12); circle(x,y,r);
setfillstyle(1,2);
floodfill(x,y,12);
repeat until keypressed;closegraph
end.
4.Описание: Нло в замкнутом пространстве на фоне звездного неба.
program ufo;
uses graph,crt;
const r=20; pause=50; var d,m,e,xm,ym,x,y,lx,ly,rx,ry, size,i,dx,dy,width,height:integer; saucer:pointer;
label loop;
begin d:=detect;
initgraph(d,m,»);
e:=graphresult;
if e<> grok then writeln(grapherrormsg(e)) else begin x:=r*5; y:=r*2;
xm:=getmaxx div 4; ym:=getmaxy div 4;
ellipse(x,y,0,360,r,r div 3+2); ellipse(x,y-4,190,357,r,r div 3);
line(x+7,y-6,x+10,y-12); line(x-7,y-6,x-10,y-12);
circle(x+10,y-12,2); circle(x-10,y-12,2);
floodfill(x+1,y+4,white);
lx:=x-r-1; ly:=y-14;
rx:=x+r+1; ry:=y+r div 3+3;
width:=rx-lx+1; height:=ry-ly+1;
size:=imagesize(lx,ly,rx,ry);
getmem(saucer,size); getimage(lx,ly,rx,ry,saucer^);
putimage(lx,ly,saucer^,xorput);
rectangle(xm,ym,3*xm,3*ym);
setviewport(xm+1,ym+1,3*xm-1,3*ym-1,clipon); xm:=2*xm; ym:=2*ym;
for i:=1 to 200 do
putpixel(random(xm),random(ym),white);
x:=xm div 2;
y:=ym div 2;
dx:=10; dy:=10; repeat putimage(x,y,saucer^,xorput); delay(999);
putimage(x,y,saucer^,xorput);
loop: x:=x+dx; y:=y+dy;
if (x<0) or (x+width+1>xm) or (y<0) or (y+height+1>ym) then begin x:=x-dx; y:=y-dy;
dx:=getmaxx div 10-random(getmaxx div 5); dy:=getmaxy div 30-random(getmaxy div 15); goto loop end until keypressed;
if readkey=#0 then x:=ord(readkey);
closegraph end
end.
5.Описание: Наполнение квадрата случайными линиями различных цветов.
program graphik;
uses graph,crt;
var d,r,e:integer; x1,y1,x2,y2:integer;
begin clrscr;
d:=detect;
initgraph(d,r,»);
e:=graphresult;
if e <> grok then writeln(grapherrormsg(e)) else begin x1:=getmaxx div 3;
y1:=getmaxy div 3;
x2:=4*x1;y2:=4*y1;
rectangle(x1,y1,x2,y2);
setviewport(x1+1,y1+1,x2-1,y2-1,clipon);
repeat setcolor(succ(random(16)));
line(random(x2-x1),random(y2-y1),random(x2-x1),random(y2-y1))
until keypressed;
if readkey=#0 then d:=ord(readkey);
closegraph
end end.
6.Описание: Медлительно выезжающий кусочек пирога либо пиццы.
program pie;
uses crt,graph;
var graphdriver,graphmode,errorcode:integer; j,v,l,m,k,i:integer;
begin graphdriver:=detect;
initgraph(graphdriver,graphmode,»);
errorcode:=graphresult;
if errorcode<>grOk then begin writeln(‘ЋиЁЎЄ Ја дЁЄЁ: ‘,graphErrorMsg(errorcode));
writeln(‘Џа®Ја ¬¬ ў аЁ©® § ўҐаиЁ« а Ў®вг…’);
halt(1); end;
setcolor(yellow);
circle(200,200,50);
floodfill(199,199,yellow);
delay(30000);
setcolor(black);
pieslice(200,200,30,60,50);
for i:=1 to 20 do begin setcolor(yellow);
pieslice(200+i,200-i,30,60,50);
setcolor(black);
pieslice(200+i,200-i,30,60,50);
delay(30000);
i:=i+1; end;
readkey;
closegraph;
end.
7.Описание: Статичное изображение двухколесного велика.
program gr;
uses graph;
var grDriver:integer;
grMobe:integer;
Begin grDriver:=Detect;
InitGraph(grDriver,grMobe,»);
SetColor(12);
circle(200,150,30);circle(200,150,23);circle(330,150,30);circle(330,150,23);line(200,150,280,150);line(280,150,320,110);line(320,110,210,110);line(210,110,250,150);line(200,150,210,110);circle(200,150,5);circle(270,150,10);line(270,150,270,170);line(265,170,275,170);line(200,145,270,140);line(200,155,270,160);line(330,150,320,110);line(320,110,320,98);line(320,98,310,98);line(210,110,210,100);circle(210,100,5);line(210,100,220,100);line(270,150,270,130);line(265,130,275,130);readln;
End.
8.Описание: Приближающийся на смотрящего квадрат. Повышение размеров по времени.
program gr;
uses graph,crt;
VAR x,y,i:integer;
PROCEDURE grafika_on;
Var drv,mode:integer;
BEGIN drv:=9; {VGA }mode:=2; {VGAHi}
initgraph(drv,mode,»);END;
BEGIN grafika_on;
x:=300; y:=200;
for i:=1 to 100 do begin setcolor(9);
rectangle(x-i,y-i,x+i,y+i);
delay(100); setcolor(0); rectangle(x-i,y-i,x+i,y+i);
end; readkey; closegraph;
END.
9. Описание:Стройку башни по блокам.
program gr;
Uses crt, Graph;Var P:pointer;Size:Word; X1,Y1:Word; gd,gm: integer;
Begin gd:=detect;
InitGraph(gd,gm,»);
IF GraphResult<>0 THEN Halt(1);
SetViewPort(0,0,640,80,TRUE);
ClearViewPort;
SetBkColor(black);SetColor(yellow);
SetLineStyle(0,1,Thickwidth);Rectangle(120,400,200,440);
Size:=ImageSize(120,400,200,440);
GetMem(p,Size);
GetImage(120,400,200,440,P^);
Y1:=440;
WHILE Y1>=40 DO begin X1:= 120;
begin PutImage(X1,Y1,p^,CopyPut); Delay(59000);
X1:=X1+80 end;
Y1:=Y1-40 end; x1:=x1-160;WHILE X1<=280 DO Begin PutImage(X1,Y1,p^,CopyPut);
X1:=X1 +160 end;
setfillstyle(8,red);
Bar(200,40,280,500); Bar(40,40,120,500);
SetColor(11);SETTEXTSTYLE(6,7,6);
outtextxy(350,100,’BASHNYA!’);Readln;
CloseGraph End.
10. Описание:Пульсирующее несколько рядов один за иным.
program snegovik;
uses graph;
var i,j,x,y:integer;grdriver:integer;grmode:integer;begin grdriver:=detect;initgraph(grdriver,grmode,’c’);
x:=50;y:=30;
for i:=1 to 10 do begin for j:=1 to 10 do begin setcolor(blue);
circle(x,y,10);circle(x,y+30,20);
circle(x,y+80,30);circle(x-30,y+30,10);
circle(x+30,y+30,10);setcolor(5);
line(x,y-5,x+15,y);line(x,y+5,x+15,y);setcolor(white);
line(x-5,y+5,x+5,y+5);
putpixel(x-5,y-5,white);putpixel(x+5,y-5,white);
putpixel(x,y+20,white);putpixel(x,y+30,white);
putpixel(x,y+40,white);putpixel(x,y+60,white);
putpixel(x,y+70,white);putpixel(x,y+80,white);
putpixel(x,y+90,white);putpixel(x,y+100,white);setcolor(3);
line(x-5,y-10,x+5,y-10);line(x+5,y-10,x,y-20);line(x,y-20,x-5,y-10);
x:=x+90;end;
y:=y+160;x:=50;
end;readln
end.
14.Описание:
Снежика, рисуемая зависимо от длины и количества лучей и глубины рекурсии.
Program Snezhinka;
Uses crt, graph;
const k = 150; n = 8; g = 4;
var gd, gm: integer; procedure Snezhinka_v_zh (x, y: Word; r, c: byte); var alpha: real; i: byte; xd, yd: integer;
begin if c < 1 then exit;
for i := 1 to n do
begin alpha := 2 * Pi * i / n;
xd := round(x + r * cos(alpha));
yd := round(y + r * sin(alpha));
moveto(x, y); lineto(xd, yd);
Snezhinka_v_zh(xd, yd, r div 3, c — 1); end; end;
BEGIN initgraph(gd, gm, ‘h:tpbgi’); setcolor(11);
snezhinka_v_zh(320, 240, k, g); readkey;
closegraph;
END.
15.Описание:
Нарисовать радугу, используя элипсные дуги различных цветов.
Program Raduga;
Uses Graph;
var D,M,y,i : Integer;
begin D := Detect;
InitGraph(D,M,»);
if GraphResult <> grOk then WriteLn(GraphErrorMsg(GraphResult)) else begin y:=200;
for i:=1 to 30 do begin if i<5 then SetColor(4); if (i>5)and(i<10) then SetColor(14); if (i>10)and(i<15) then SetColor(2); if (i>20)and(i<25) then SetColor(1); if i>25 then SetColor(13);
Ellipse(325,y,10,170,240,150); inc(y); end;
Readln; CloseGraph; end;
end.
]]>