Поможем написать учебную работу
Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
АКТЮБИНСКИЙ ПОЛИТЕХНИЧЕСКИЙ КОЛЛЕДЖ
ОТЧЕТ
ПО УЧЕБНОЙ ПРАКТИКЕ
Выполнил: Журмухамедов Марат
Проверила: Гайсагалеева Б.М.
АКТОБЕ 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. Составить алгоритм вычисления y=55*(a +b)
program as; Блок-схема
uses crt;
var a,b,c,y:integer;
begin clrscr;
writeln('Введи значение a,b);
readln(a,b);
C: = A +B
c:=a+b;y:=55*c;
writeln('y=',y);
Y: = 55* C
readln;end.
(Вводим значение 5,3)
Ответ:440
Задание 2. Составить алгоритм обмена значений 2х переменных A и B
program as; Блок-схема
uses crt;
var a,b,c:integer;
begin clrscr;
writeln(‘Введи значение a,b');
readln(a,b);
c:=a;
C: = A;
A: = B;
B: = C;
a:=b;b:=c;
writeln('obmen',a,'-',b);
readln;
end.
(Вводим значение 5,6)
Ответ: 6,5
Задание 3. Вычислить площадь огорода, имеющего форму прямоугольника, если известны стороны А и В
program as; Блок-схема
uses crt;
var a,b,c:integer;
begin clrscr;
writeln('Введи стороны А и В ');
readln(a,b);
C: = (A + B)*2
c:=(a+b)*2;writeln('Площадь огорода =',c);
readln;
end.
(Вводим значение 5,6)
Ответ:22
Задание 4. Найти среднее арифметическое чисел x,y,z
program as; Блок-схема
uses crt;
var x,y,z:integer; d:real;
begin clrscr;
writeln('Bведи x,y,z');
readln(x,y,z);
D: =(X+Y+Z)/3
d:=(x+y+z)/3;writeln(d:5:2);
readln;
end.
(Вводим значение 5,6,7)
Ответ: 6.00
Задание 5.Найти массу х литров молока, если известно, что плотность молока р кг/м3
program as; Блок-схема
uses crt;
var x,p,m:real;
begin clrscr;
writeln('Bведи х(литры),р(плотность)молока ');
М:=Х/100*Р
readln(x,p);m:=x/100*p;
writeln(m);
readln;
end.
(Вводим значение 7л, 1030кг/м3)
Ответ: 7,21 кг
Задание 6.Объем цилиндра равен V,а площадь основания – S. Какова высота цилиндра H?
program as; Блок-схема
uses crt;
var v,s,h:real;
begin clrscr;
writeln('Введи объем цилиндра и площ. его осн. ');
readln(v,s);
H := V/S
H:=v/s;writeln('Высота цилиндра=',H);
readln;
end.
(Вводим значение 10,5)
Ответ: 2м
Задание 7.Дана длина куба а. Найти объем куба v и площадь его боковой поверхности s.
program as;
uses crt;
var v,s,a:real;
begin clrscr;
V:=a*a*a
S:=4*a*a
writeln('Bведи длину ребра куба');readln(a);
v:=a*a*a;
s:=4*a*a;
writeln(‘объем=’,v,’площ.бок.пов.=’,s);
readln;
end.
(Вводим значение 5)
Ответ:v=125,s=100
Задание 8. Составить алгоритм вычисления y=22*((a +b)/2)
program as; Блок-схема
uses crt;
var a,b,c:integer; d,y:real;
begin clrscr;
writeln('Введи значение а,b');
readln(a,b);
C:= a +b
c:=a+b;
D:=c/2
d:=c/2;y:=sqr(2)*d;
Y:=(2*2)*d
writeln(y:5:2);readln;
end.
(Вводим значение 5,5)
Ответ: 20
Задание 9.Известна длина окружности.Найти площадь круга, огранич. этой окружностью
program as; Блок-схема
uses crt;
var a,b:real;
begin clrscr;
writeln('Введи длину окужности');
readln(a);
B :=(A*A)*PI
b:=(a*a)*pi;writeln('Найти S круга=',b:5:2);
end.
(Вводим значение 5)
Ответ:78,5
Задание10. Дано натуральное число n(n>9).Найти число единиц в нем
program as; Блок-схема
uses crt;
var a,d:integer;
begin clrscr;
writeln('Введи натуральное чисно');
readln(a);
D:=a mod 10
d:=a mod 10;writeln('Число единиц в нем=',d);
readln;
end.
(Вводим значение 6)
Ответ: единиц=6
Задание11.Дано расстояние в сантиметрах. Найти число полных метров в нем.
program as; Блок-схема
uses crt;
var a,m:integer;
begin clrscr;
writeln('Введи расстояние в сантиметрах');
readln(a);
M:=a div 100
m:=a div 100;writeln('Получи расстояние в метрах',m);
readln;
end.
(Вводим значение 200)
Ответ: 2м
Задание12. Составить алгоритм вычисления y=7x2-3x+6
program as; Блок-схема
uses crt;
var x,y:integer;
begin clrscr;
writeln('Bведи значение х ');
C:=7*x*x
D:=3*x
readln(x);y:=7*(sqr(x))-3*x+6;
writeln('Y=',y);
Y:=C-D+6
readln;end.
(Вводим значение 6)
Ответ: 240
Задание13.Каков объем кислорода, содержащегося в комнате размером a*b*c,если кислород составляет 21% объема воздуха?
program as; Блок-схема
uses crt;
var a,b,c,v:real;
begin clrscr;
writeln('Bвeди a,b,c');
readln(a,b,c);
V:=0.21*a*b*c
v:=0.21*a*b*c;writeln('объем кислорода=',v);
readln;
end.
(Вводим значение 5,6,7)
Ответ: 4.41
Задание14. Составить алгоритм вычисления A=x2+bx/2
program as; Блок-схема
uses crt;
var a,b,x,z,s,v:real;
begin clrscr;
writeln('Введи значение x,b');
Z:=x*x*x*x*x
readln(x,b);
S:=b*x
z:=x*x*x*x*x;s:=b*x;
V:=z+s
v:=z+s;A:=v/2;
A:=v/2
writeln('A=',a);readln;
end.
(Вводим значение 2,3)
Ответ: 1.9
Задание15.Определить время падения камня на поверхность земли с высоты h.
program as; Блок-схема
uses crt;
var g,t,h:real;
begin clrscr;
writeln('Введи значение h');
G:=9.81
readln(h);t:=sqrt(2*h/g);
T:=sqrt(2*h/g)
writeln('время падения=',t);readln;
end.
(Вводим значение 10 м)
Ответ: 1,4278с
Программа с ветвлениями
Задание 1.Даны 2 целых числа, определить какое из них больше
Program as; Блок-схема
Uses crt;
Var a,b:integer;
Max:integer;
Begin clrscr;
Writeln(‘Введи 2 числа’);
Readln(a,b);
Max:=b
Max:=a
If a>b then max:=a else max:=b;Writeln(‘Максимально=’,max);
Readln;
End.
(Вводим значение 5,6)
Ответ: 6
Задание 2.Известны стороны треугольника, определить равны ли его стороны (равноб) или разносторон.
program as; Блок-схема
uses crt;
var a,b,c:integer;
begin clrscr;
writeln('Введи стороны ');
readln(a,b,c);
if (a=b) or (a=c) or (c=b) Да Нет
then writeln('равноб.') else writeln
('разност.');
readln;
end.
(Вводим значение 5,5,6)
Ответ: Равноб.
Задание 3.Проверить, принадлежит ли число, введенное с клавиатуры, интервалу (-5;3).
Program as; Блок-схема
Uses crt;
Var a,b,x:integer;
Begin clrscr;
Readln(x);
If (x>=-5) and (x<=3) then
Writeln(‘да’) else writeln(‘нет’);
End.
(Вводим значение 2)
Ответ: Принадлежит
Задание 4.Дано 2х зн. число. Определить входит ли в него цифра 3
Program as; Блок-схема
Uses crt;
Var a: integer;
Begin clrscr;
Writeln(‘Введи 2х зн. число’);
Readln(a);
If (a div 10=3) or (a mod 10=3)
Then writeln(‘Входит’);
Else writeln(‘Не входит’);
Readln;
End.
(Вводим значение 53)
Ответ: Входит
Задание 5. Дано 2х зн. число. Определить какая из его цифр больше
Program as; Блок-схема
Uses crt;
Var a,d,e, max: integer;
Begin clrscr;
Writeln(‘Дано 2х зн. число’);
D:=a div 10
E:=a mod 10
Readln(a);D:=a div 10;
E:=a mod 10;
If d>e then max:=d else max:=e;
Writeln(‘Макс=’,max);
Readln;
Max:=e
Max:=d
End.
(Вводим значение 96)
Ответ: 9
Задание 6.Даны 2 целых числа А и В, выяснить яв. ли 2 числа, четными
Program as; Блок-схема
Var a,b: integer;
Begin clrscr;
Writeln(‘Введи 2 целых числа А и В’);
Readln (a,b);
If a mod 2=0 then writeln(‘четное’)
else writeln(‘не четное’);
If b mod 2=0 then writeln(‘четное’);
else writeln(‘не четное’);
Readln;
End.
(Вводим значение 5,6)
Ответ: не четное, четное
Задание 7.Решить пример -4x2+8,x<0
Y=
x2 +3x+4,x>0 Блок-схема
Program as;
Uses crt;
Var x,y:integer;
Begin clrscr;
Writeln(‘Введи аргумент x’);
Readln(x);
If x>0 then Y:=-4*sqr(x)+8
Y:=sqr(x)+3*x+4
Y:=-4*sqr(x)+8
else Y:=sqr(x)+3*x+4;writeln(‘Y=’,y);
readln;
end.
Задание 8. Даны три вещественных числа a,b,c. Проверить выполняется ли неравенство a<b<c.
program as; Блок-схема
uses crt;
var a,b,c:integer;
begin clrscr;
writeln(‘Введи три числа’);
readln(a,b,c);
if (a<b) and (b<c) then writeln(‘верно’)
else writeln(‘не верно’);
readln;
end.
(Вводим значение 5,6,7)
Ответ: выполняется
Задание 9.Даны три вещественных числа. Определить, имеется ли среди них хотя бы пара равных между собой чисел
Program as; Блок- схема
Uses crt;
Var a,b,c:integer;
Begin clrscr;
Writeln(‘Введи 3 числа’);
Readln(a,b,c);
If (a=b) or (a=c) or (b=c) then writeln(‘имеется’)
else writeln(‘не имеется’);
end.
(Вводим значение 5,6,7)
Ответ: не имеется
Задание10.Дано вещественное число. Вывести на экран его абсолютную величину
Program as; Блок-схема
Uses crt;
Var a:real;
Begin clrscr;
Readln(a);
if (a>0) or (a<0)then writeln(abs(a):5:2);
readln;
end.
(Вводим значение 56)
Ответ: получаем абсол. величину.
Задание11. Даны 2 целых числа, определить какое из них меньше
Program as; Блок-схема
Uses crt;
Var a,b:integer;
Min:integer;
Begin clrscr;
Writeln(‘Введи 2 числа’);
Readln(a,b);
min:=b
min:=a
If a<b then min:=a else min:=b;Writeln(‘Минимальное=’,min);
Readln;
End.
(Вводим значение 5,6) Ответ: 5
Задание12. Даны 2 числа. Если кв.корень из второго числа меньше первого числа, то увеличить второе число в 5 раз
program as; Блок-схема
uses crt;
var a,b,d,c:real;
begin clrscr;
writeln(‘Введи 2 числа’);
readln(a,b);
D:=sqrt(a)
C:=sqrt(b)
d:=sqrt(a);c:=sqrt(b);
if (d<c) then
writeln(‘увеличить 2 число в 5 раз’,c*c*c*c*c:5:2)
else writeln(‘нет решения’);
readln;
end.
Ответ: нет решения
Задание13. Дано число. Если это число чётное, то /2 если нет, то *2
Program as; Блок-схема
Var a: integer;
Begin clrscr;
Writeln(‘Введи число’);
Readln (a);
If a mod 2=0 then writeln(a/2)
else writeln(a*2);
Readln;
End.
(Вводим значение 5)
Ответ:10
Задание14.Даны 4 вещественных числа. Найти сумму тех чисел, которые больше 5
Program as; Блок-схема
Uses crt;
Var a,b,c,d,k,z,x,v:integer;
Begin clrscr;
Writeln(‘Введи 4 числа’);
Readln(a,b,c,d);
If a>5 then k:=a;
If b>5 then z:=b;
If c>5 then x:=c;
If d>5 then v:=d;
Writeln(‘Общая сумма=’,k+z+x+v);
End.
(Вводим значение 6,6,6,6)
Ответ: 24
Задание15.Даны 3 числа a,b,c. Найти максимальное
Program as; Блок-схема
Uses crt;
Var a,b,c:integer;
Max,max1:integer;
Begin clrscr;
Writeln(‘Введи 3 числа’);
Readln(a,b,c);
Max:=b
Max:=a
If a>b then max:=a else max:=b;If max>c then max1:=max else max1:=c;
Writeln(‘Максимально=’,max1);
Readln;
Max1:=c
Max1:=max
End.(Вводим значение 5,6,7)
Ответ: 7
Циклическая программа
Задание 1.Напечатать “столбиком”: все целые числа от 20 до 35
Program as; Блок-схема
Uses crt;
Var a:integer;
A:=20
Begin clrscr;For a:=20 to 35 do writeln(a);
Readln;
end.
Задание 2.Напечатать “столбиком”: квадраты всех целых чисел от 10 до b (значение b вводится с клавиатуры, причем b>10)
Program as; Блок-схема
Uses crt;
Var a,j:integer;
A:=10
Begin clrscr;Writeln(‘Введи число’);
Readln(j);
For a:=10 to j do writeln(sqrt(a):5:2);
Readln;
end.
A+1
Задание 3.Найти сумму квадратов всех целых чисел от 10 до 50
Program as;
Uses crt;
A:=10
Var a,s:real;Begin clrscr;
For a:=10 to 50 do s:=sqr(a)+s;
Writeln(s);
S:=sqr(a)+s
end.
Задание 4.Одна штука некоторого товара стоит 20 тенге. Напечатать таблицу стоимости 2,3…20 штук этого товара
Блок-схема
Program as;
A:=2
B:=20
Uses crt;Var a,b:integer;
Begin clrscr;
B:=20;
For a:=2 to 20 do writeln(a*b);
Readln;
end.
Задание 5. Найти произведение всех целых чисел от 1 до А (значение А вводится с клавиатуры; 1<=A<=20.
program as; Блок-схема.
uses crt;
P:=1
B:=1
)+s
var a,b,p:integer;begin clrscr;
p:=1;
readln(a);
for b:=1 to a do if (1<=a) and (a<=20) then
p:=p*a;
writeln(p);
readln;
end.
P:=p*a
(Вводим значение 4)Ответ:256
Задание 6.Напечатать программу, печатающую таблицу значений функции y=cos2x на отрезке [0;1] с шагом h=0,1
Program as; Блок-схема
Uses crt;
Var y,x:real;
X:=0
Begin clrscr;X:=0;
While x<=1 do begin y:=cos(2*x);
Writeln(y:5:2);
Y:=cos(2*x)
X:=x+0,1
X:=x+0,1;End;
End.
Задание 7.Напечатать программу, вычисления факториала
Program as; Блок-схема
Uses crt;
Var i,n:integer;
F:=1;
I:=1;
f:real;Begin clrscr;
Readln(n);
F:=1; i:=1;
While i<=n do begin f:=f*i;
F:=f*I;
I:=succ(i);
i:=succ(i);end;
Writeln(‘факториал от’,n,’равен’,f);
End.
Задание 8.Программа подсчета суммы S первых 1000 членов гармонического ряда 1+1/2+1/3+…1/N
Program as; Блок-схема
Uses crt;
S:=0;
N:=0;
Var s:real;N:integer;
Begin clrscr;
S:=0;N:=0;
While n<1000 do begin N:=n+1;
S:=s+1/N;
End;
N:=n+1;
S:=s+1/N;
Writeln(s);
Readln;
End.
Задание 9.Вычислить наибольший общий делитель двух натуральных чисел А и В.
Program as; Блок-схема
Uses crt;
Var a,b:integer;
Begin clrscr;
writeln(‘Введи 2 натур. Числа’);
readln(a,b);
While a<>b do if a>b then a:=a-b
Else b:=b-a;
A:=a-b
B:=b-a
Writeln(‘НОД=’,a);Readln;
End.
Задание10. Даны целые числа А и В (а>b).Определить: Результат целочисленного деления А на В, не используя стандартную операцию целочисленного деления
Program as; Блок-схема
Uses crt;
Var a,b,n:integer;
Begin clrscr;
writeln(‘Введи 2 числа,a>b’);
readln(a,b);
N:=n+1;
A:=a-b;
n:=0;While a<=b do begin
N:=n+1;
A:=a-b;
\ End;
Writeln(‘результат=’,n);
Readln;
End.
Задание11.Напишите программу, которая вводит целые числа с клавиатуры и складывает их, пока не будет введено число 0
Program as; Блок-схема
Uses crt;
Var N,s:integer;
S:=0;
Begin clrscr;S:=0;
Repeat write (‘Введи число’);
S:=s+n;
Readln(n);S:=s+n;
Until n=0;
Writeln(‘S=’,s);
Readln;
End.
Задание12. Напечатайте 20 первых степеней числа 2
Program as; Блок-схема
Uses crt;
Var N,s:longint;
S:=1;n:=1;
Begin clrscr;
S:=s*2;
N:=n+1;
S:=1; n:=1;Repeat s:=s*2;
Write(s,’ ‘);
N:=n+1;
Until n>20;
Readln;
End.
Задание13. Известны оценки по информатике 20 учеников класса. В начале списка перечислены все пятерки, затем все остальные оценки. Сколько учеников имеют по инфор-ке оценку «5»?
Program as; Блок-схема
Uses crt;
Var x,n:integer;
Begin clrscr;
Write(‘Введи оценку’);
Readln(x);
N:=0;
N:=n+1;
While x=5 do beginN:=n+1;
Write(‘Введи оценку’);
Readln(x);
End;
Writeln(‘имеют отлично’,n,’учеников’);
End.
Задание14.Вывести на экран таблицу умножения.
Program as; Блок-схема
Uses crt;
Var I,j:integer;
I:=1
Begin clrscr;For i:=1 to 9 do
For j:=1 to 9 do writeln(I,*,j,’ ‘,i*j);
Readln;
J:=1
End.Задание15.Составить программу, печатающую на экране все четные числа в диапазоне от 100 до 999.
Program as; Блок-схема
Uses crt;
Var a:integer;
A:=100
Begin clrscr;For a:=100 to 999 do
If a mod 2=0 then writeln(a);
End.
Массивы
Задание 1.Создать одномерный массив и найти сумму четных элементов и произведение нечетных элементов
program as;
uses crt;
var a:array[1..5] of integer;
i,s,p:integer;
begin clrscr;
for i:=1 to 5 do a[i]:=random(8);
for i:=1 to 5 do begin
writeln;
for i:=1 to 5 do write(a[i]:5);
end;
writeln;
for i:=1 to 5 do
if a[i] mod 2=0 then
s:=s+a[i]; writeln;
p:=1;
for i:=1 to 5 do
if a[i] mod 2<>0 then p:=p*a[i];
writeln;
writeln(s);
writeln(p);
end.
Задание 2.Составить программу формирования одномерного массива и вычисления произведения всех элементов массива
program as;
uses crt;
var a:array[1..5] of integer;
i,s,p:integer;
begin clrscr;
for i:=1 to 5 do a[i]:=random(8);
for i:=1 to 5 do begin
writeln;
for i:=1 to 5 do write(a[i]:5);
end;
writeln;
p:=1;
for i:=1 to 5 do p:=p*a[i];
writeln(p); end.
Задание 3.Дан одномерный массив вычислить произведение всех четных элементов массива
program as;
uses crt;
var a:array[1..5] of integer;
i,s,p:integer;
begin clrscr;
for i:=1 to 5 do a[i]:=random(8);
for i:=1 to 5 do begin
writeln;
for i:=1 to 5 do write(a[i]:5);
end;
writeln;
p:=1;
for i:=1 to 5 do if a[i] mod 2=0 then p:=p*a[i];
writeln(p);
end.
Задание 4.Дан массив вычислить сумму всех элементов больше 5
program as;
uses crt;
var a:array[1..5] of integer;
i,s,p:integer;
begin clrscr;
for i:=1 to 5 do a[i]:=random(88);
for i:=1 to 5 do begin
writeln;
for i:=1 to 5 do write(a[i]:5);
end;
writeln;
for i:=1 to 5 do if a[i]>5 then p:=p+a[i];
writeln(p);
readln;
end.
Задание 5.Подщитать кол-во элементов равных 7
program as;
uses crt;
var a:array[1..7] of integer;
i,s,p:integer;
begin clrscr;
for i:=1 to 7 do a[i]:=random(88);
for i:=1 to 7 do begin
writeln;
for i:=1 to 7 do write(a[i]:5);
end;
writeln;
for i:=1 to 7 do if a[i]=7 then p:=p+1;
writeln(p);
readln;
end.
Задание 6. Дан массив умножить все элементы на 20
program as;
uses crt;
var a:array[1..7] of integer;
i,s,p:integer;
begin clrscr;
for i:=1 to 7 do a[i]:=random(88);
for i:=1 to 7 do begin
writeln;
for i:=1 to 7 do write(a[i]:5);
end;
writeln;
for i:=1 to 7 do
write(a[i]*20:3);
readln;
end.
Задание 7. Дан массив все четные элементы заменить на 2, а не четные удвоить
program as;
uses crt;
var a:array[1..7] of integer;
i,s,p:integer;
begin clrscr;
for i:=1 to 7 do a[i]:=random(88);
for i:=1 to 7 do begin
writeln;
for i:=1 to 7 do write(a[i]:5);
end;
writeln;
for i:=1 to 7 do if a[i] mod 2=0 then writeln(sqr(a[i]));
for i:=1 to 7 do if a[i] mod 2<>0 then writeln(2*a[i]);
readln;
end.
Задание 8. Дан одномерный массив найти максимальный элемент
program as;
uses crt;
var a:array[1..15] of integer;
i,max:integer;
begin clrscr;
for i:=1 to 15 do a[i]:=random(88);
for i:=1 to 15 do begin
writeln;
for i:=1 to 15 do write(a[i]:5);
end;
writeln;
max:=1;
for i:=1 to 15 do if a[i] >a[max] then max:=i;
writeln(a[max]);
readln;
end.
Задание 9. Дан одномерный массив найти min элемент
program as;
uses crt;
var a:array[1..15] of integer;
i,min:integer;
begin clrscr;
for i:=1 to 15 do a[i]:=random(88);
for i:=1 to 15 do begin
writeln;
for i:=1 to 15 do write(a[i]:5);
end;
writeln;
min:=1;
for i:=1 to 15 do if a[i]<a[min] then min:=i;
writeln(a[min]);
readln;
end.
Задание10. Дан массив скопировать все его элементы в другой массив такого же элемента
program as;
uses crt;
var a:array[1..15] of integer;
I,b:integer;
begin clrscr;
for i:=1 to 15 do a[i]:=random(88);
for i:=1 to 15 do begin
writeln;
for i:=1 to 15 do write(a[i]:5);
end;
writeln;
for i:=1 to 15 do a[i]:=b[i];
for i:=1 to 15 do write(a[i]);
writeln(‘скопир’);
for i:=1 to 15 do write(b[i]:4);
readln;
end.
Задание11. Составить программу обмена первого и третьего элем. строки матрицы
program as;
uses crt;
var a:array[1..15] of integer;
I,b,c:integer;
begin clrscr;
for i:=1 to 15 do a[i]:=random(88);
for i:=1 to 15 do begin
writeln;
for i:=1 to 15 do write(a[i]:5);
end;
writeln;
c:=a[1];
a[1]:=a[3];
a[3]:=c;
for i:=1 to 15 do write(a[i]:5);
end.
Задание12. Дан 2 мерный массив. Вывести на экран все элементы второй строки
program as;
uses crt;
var a:array[1..4,1..4] of integer;
i,j:integer;
begin clrscr;
for i:=1 to 4 do
for j:=1 to 4 do a[i,j]:=random(99);
for i:=1 to 4 do begin
writeln;
for j:=1 to 4 do write(a[i,j]:5);
end;
writeln;
writeln;
for j:=1 to 4 do write(a[2,j]:3);
end.
Задание13. Дан одномерный массив. Поменять содержимое двух произвольных ячеек
program as;
uses crt;
var a:array [1..10] of integer;
i,k,m:integer;
begin clrscr;
writeln;
for i:=1 to 10 do a[i]:=random(99);
for i:=1 to 10 do write(a[i]:5);
writeln;
writeln;
k:=a[2];
a[2]:=a[4];
a[4]:=k;
for i:=1 to 10 do write(a[i]:5);
end.
Задание14. Дан 2 мерный массив. Заменить все элементы кратные 5, нулями
program as;
uses crt;
var a:array[1..5,1..5] of integer;
i,j,s:integer;
begin clrscr;
for i:=1 to 5 do
for j:=1 to 5 do a[i,j]:=random(6);
for i:=1 to 5 do begin
writeln;
for j:=1 to 5 do write(a[i,j]:5);
end;
writeln;
for i:=1 to 5 do
for j:=1 to 5 do begin
if a[i,j] mod 5=0 then a[i,j]:=0;
end;
for i:=1 to 5 do begin writeln;
for j:=1 to 5 do write(a[i,j]:5);
end;
end.
Задание15. Дан массив вычислить сумму всех элементов больше 20
program as; end;
uses crt; writeln;
var a:array[1..10] of integer; for i:=1 to 10 do if a[i]>20 then p:=p+a[i];
i,s,p:integer; writeln(p);
begin clrscr; readln;
for i:=1 to 10 do a[i]:=random(88); end.
for i:=1 to 10 do begin
writeln;
for i:=1 to 10 do write(a[i]:5);
Процедуры и функции
Задание 1. Составить программу вычисления числа сочетания C= n!(n-m)!
program as;
uses crt;
var m,n,p1,p2,p3:integer;
c:real;
procedure factor(x:integer; var p:integer);
var i:integer;
begin p:=1;
for i:=1 to x do p:=p*i;
end;
begin clrscr;
writeln('Vvedi m,n');
readln(m,n);
factor(m,p1);
factor(n,p2);
factor(n-m,p3);
c:=p1/(p2*p3);
writeln(c:5:2);
end.
Задание 2. Составить программу нахождения меньшего из 5 заданных чисел, используя процедуру нахождения меньшего из 2 заданных чисел
Program as;
Uses crt;
Var a,b,c,d,e,z1,z2,z3,z4,z5:integer;
Procedure min(x,y:integer; var z:integer);
Begin;
If x<y then z:=x else z:=y;
Writeln(z);
End;
Begin clrscr;
Readln(a,b,c,d,e);
Min(a,b,z1);
Min(z1,c,z3);
Min(z3,d,z4);
Min(z4,e,z5);
End.
Задание 3. Написать программу нахождения суммы большего и меньшего из 3 заданных чисел
Program as;
Uses crt;
Var a,b,c,d,v,v1,max,max1,min,min1:integer;
Procedure ma(x,y,z:integer; var v:integer);
Begin clrscr;
If x<y then max:=x else max:=y;
If max<z then max1:=max else max1:=z;
If x>y then min:=x else min:=y;
If min>z then min1:=min else min1:=z;
V:=min1+max1;
End;
Begin clrscr;
Readln(a,b,c);
Ma(a,b,c,v1);
Writeln(v1);
End.
Задание 4. Составить программу вычисления суммой фактор. всех четных чисел от m до n
program as;
uses crt;
var a,b,c,n,m,s,k,p1,p:integer;
procedure factor(x:integer; var p:integer);
var i:integer;
begin p:=1;
for i:=1 to x do begin p:=p*I; end;
writeln(p);
end;
begin clrscr;
writeln(‘ Vvedi n,m’);
readln(n,m);
for k:=n to m do if k mod 2=0 then begin
factor(k,p1);
s:=s+p1;
end;
writeln(s);
end.
Задание 5. Даны 5 чисел, найти их наибольший общий делитель, используя процедуру. Для алгоритма их вида
program as;
uses crt;
var a,b,c,d,e,z1,z2,z3,z:integer;
procedure E(x,y:integer; var z:integer);
begin
while x<>y do if x>y then x:=x-y
else y:=y-1;
z:=x;
end;
begin clrscr;
writeln(‘ Vvedi a,b,c,d,e’);
readln(a,b,c,d,e);
E(a,b,z);
E(c,d,z1);
E(z,z1,z2);
E(z2,e,z3);
writeln(z3);
end.
M!
Задание 6. Составить программу вычисления числа сочетания C= n!(n-m)! с помощью функции
program as;
uses crt;
var f1,f2,f3,m,m1,n:integer;
c:real;
Function factor(n:integer):integer;
var p,i:integer;
begin p:=1;
for i:=1 to n do p:=p*i;
factor:=p;
end;
begin
read(m, n);
f1:=factor(m);
f2:=factor(n);
m1:=n-m;
f3:=factor(m1);
c:=f1/(f2*m1);
writeln(c:5:2);
end.
Задание 7. Найти НОК двух чисел по формуле НОК(a,b)=НОД
Program as;
Uses crt;
Var m, n,z,nod,a,nok:integer;
Procedure F (a,b:integer; var nod:integer);
Begin
While a<>b do if a>b then a:=a-b else b:=b-a;
Nod:=a;
End;
Begin clrscr;
Readln(m,n);
F (m,n,z);
Nok:= trunk (z/(m*n));
Writeln(nok);
End.
Задание 8. Трехугольник задан с координ. своих вершин. Составить программу вычисления его периметра
Program as;
Uses crt;
Var a1,a2,c1,c2,b1,b2:integer;
d1,d2,d3,d:real;
c,p:real;
procedure F(x1,x2,y1,y2:integer; var d:read);
begin
d:=sqrt(sqr(x2-x1)+sqr(y2-y1));
writeln(d:5:2);
end;
begin clrscr;
readln(a1,a2,b1,b2,d1,d2);
F(a1,a2,c1,c2,d1);
F(c1,c2,b1,b2,d2);
F(d1,d2,a1,a2,d3);
P:=d1+d2+d3;
Writeln(p:8:5);
End.
Задание 9. Увеличить вдвое все элементы массива
program as;
const n=10; m=20;
type T1 = array[1..n] of integer;
T2 = array[-m..m] of integer;
var A: T1; B: T2; k: integer;
Procedure Double(var X: array of integer);
var i: byte;
begin
for i:=0 to High(X)-1 do X[i]:=X[i]*2;
end;
begin
for k:=1 to n do read(A[k]);
for k:=-m to m do read(B[k]);
Double(A);
Double(B);
Double(k);
writeln('k=',k);
for k:=1 to n do write(A[k],' ');
writeln;
for k:=-m to m do write(B[k],' ');
end.
Задание 10. Использование типизированных констант
program typed_const;
var N:integer;
procedure Test;
const k:integer=1;
begin
if k<N then
begin
writeln(k,'-й вызов процедуры');
k:=k+1;
Test;
end
else writeln('последний вызов процедуры');
end;
begin
read(N);
if N>0 then Test;
end.
Задание 11. Вычислить N-е число Фиббоначчи
program Fib;
var n:byte;
function F(k:byte):word;
begin
if k<2 then F:=1 else F:=F(k-1)+F(k-2);
end;
begin
write('введите номер числа Фиббоначчи ');
readln(N);
writeln(N,'-е число Фиббоначчи =',F(N));
readln
end.
Задание12. Даны 5 чисел, найти их наибольший общий делитель, используя процедуру. Для алгоритма их вида
program as;
uses crt;
var a,b,c,d,e,z1,z2,z3,z:integer;
procedure E(x,y:integer; var z:integer);
begin
while x<>y do if x>y then x:=x-y
else y:=y-1;
z:=x;
end;
begin clrscr;
writeln(‘ Vvedi a,b,c,d,e’);
readln(a,b,c,d,e);
E(a,b,z);
E(c,d,z1);
E(z,z1,z2);
E(z2,e,z3);
writeln(z3);
end.
Задание13. Трехугольник задан с координ. своих вершин. Составить программу вычисления его периметра
Program as;
Uses crt;
Var a1,a2,c1,c2,b1,b2:integer;
d1,d2,d3,d:real;
c,p:real;
procedure F(x1,x2,y1,y2:integer; var d:read);
begin
d:=sqrt(sqr(x2-x1)+sqr(y2-y1));
writeln(d:5:2);
end;
begin clrscr;
readln(a1,a2,b1,b2,d1,d2);
F(a1,a2,c1,c2,d1);
F(c1,c2,b1,b2,d2);
F(d1,d2,a1,a2,d3);
P:=d1+d2+d3;
Writeln(p:8:5);
End.
Задание14. Составить программу для вычисления определенного интеграла
tk
2t
I= S--------------- dt
sqrt(1-sin2t)
tn
вычисляется по формуле:
ISimps=2*h/3*(0.5*F(A)+2*F(A+h)+F(A+2*h)+2*F(A+3*h)+...
+2*F(B-h)+0.5*F(B))
Program INTEGRAL;
type
Func= function(x: Real): Real;
var
I,TN,TK:Real;
N:Integer;
{$F+}
Function Q(t: Real): Real;
begin
Q:=2*t/Sqrt(1-Sin(2*t));
end;
{$F-}
Procedure Simps(F:Func; a,b:Real; N:Integer; var INT:Real);
var
sum, h: Real;
j:Integer;
begin
if Odd(N) then N:=N+1;
h:=(b-a)/N;
sum:=0.5*(F(a)+F(b));
for j:=1 to N-1 do
sum:=sum+(j mod 2+1)*F(a+j*h);
INT:=2*h*sum/3
end; begin WriteLn(' ВВЕДИ TN,TK,N');
Read(TN,TK,N);
Simps(Q,TN,TK,N,I);
WriteLn('I=',I:8:3)
end.
Задание15. Записать отрезок -X(-1,-10), с помощью функции
program as;
function A(x:integer):integer;
begin
a:=-x;
end;
var i:integer;
begin
for i:=1 to 10 do writeln(a(i));
end.
Файловые данные в Паскале
Задание 1. Дан текстовый файл, посчитать кол-во строк в нем
Program as;
Uses crt;
Var F:text; a:string; s:integer;
Begin clrscr;
Assign (f,’a1.txt’);
Reset (f);
While not (eof(f)) do begin
Readln(f,a);
S:=s+1; end;
Close(f);
Writeln(s);
End.
Задание 2. Создать текстовый файл и записать в него фразу: «Здравствуй Мир!»
Program as;
Uses crt;
Var F:text; a:string;
Begin clrscr;
Assign (f,’a.txt’);
Rewrite (f);
Readln(a);
Writeln(f,a);
Close(f);
End.
Задание 3. Создать текстовый файл и записать в него слово «Привет»
Program as;
Uses crt;
Var F:text; a:string;
Begin clrscr;
Assign (f,’A.txt’);
Rewrite (f);
Readln(a);
Writeln(f,a);
Close(f);
End.
Задание 4. Создать текстовый файл и записать в него 5 одинаковых чисел
Program as;
Uses crt;
Var F:text; a:string; i:integer;
Begin clrscr;
Assign (f,’text.txt’);
Rewrite (f);
For i:=1 to 5 do
Writeln(f,5);
Close(f);
End.
Задание 5. Создать текстовый файл и записать в него все числа от 10 до 16
Program as;
Uses crt;
Var F:text; a:string; i:integer;
Begin clrscr;
Assign (f,’text.txt’);
Rewrite (f);
For i:=10 to 16 do
Writeln(f,i);
Close(f);
End.
Задание 6. Создать текстовый файл и записать в него 5 одинаковых слов
Program as;
Uses crt;
Var F:text; a:string;
Begin clrscr;
Assign (f,’A.txt’);
Rewrite (f);
Readln(a);
Writeln(f,a);
Close(f);
End.
Задание 7. Дан текстовый файл перенести его строки в другой файл
Program as;
Uses crt;
Var f,t:text; a:string;
Begin clrscr;
Assign(f,’202as.txt’); assign(t,’201as.txt’);
Reset(f); rewrite(t);
While not(eof(f)) do begin
Readln(f,a);
Writeln(t,a);
End;
Close(f);
Close(t);
Readln;
End.
Задание 8. Имеется текстовый файл, напечатать все его строки начиная с буквы Т
Program as;
Uses crt;
Var f:text; a:string;
Begin clrscr;
Assign(f,’202as.txt’);
Reset(f);
While not(eof(f)) do begin
Readln(f,a);
If copy (a,1,1)=’T’ then
Writeln(a);
End;
Close(f);
Readln;
End.
Задание 9. Имеется текстовый файл посчитать кол-во строк начинающихся на букву А
Program as; readln(f,a);
Uses crt; if copy(a,1,1)=’A’ then k:=k+1;
Var F:text; a:string; k:integer; end;
Begin clrscr; close(f);
Assign(f,’abc.txt’); writeln(k);
Reset(f); end.
While not(Eof(f)) do begin
Задание10. Все четные строки этого файла записать во 2 файл, а не четные в 3 файл
Program as;
Uses crt;
Var F,t,g:text; a:string; k:integer;
Begin clrscr;
Assign(f,’abc.txt’); assign(t,’cop.txt’); Assign(g,’cap.txt’);
Reset(f); rewrite(t); rewrite(g);
While not(Eof(f)) do begin
Readln(f,a);
K:=k+1;
If k mod 2=0 then writeln(t,a) else writeln(g,a);
End;
Close(f); close(t); close(g);
End.
Задание11. Найти сумму элементов одномерного массива рез-т записать в текстовый файл
Program as;
Uses crt;
Var f:text; a:array[1..10] of integer; i,s:integer;
Begin clrscr;
Writeln(‘Ввод массива’);
Assign(f,’abc.txt’); rewrite(f);
For i:=1 to 10 do begin write(‘Введи’,I,’ элемент массива’);
Readln(a[i]);
End;
Writeln;
For i:=1 to 10 do s:=s+a[i];
Writeln(f,s);
Close(f);
End.
Задание12. Создать текстовый файл и записать в него все числа от 5 до 25
Program as;
Uses crt;
Var F:text; a:string; i:integer;
Begin clrscr;
Assign (f,’text.txt’);Rewrite (f);
For i:=5 to 25 do
Writeln(f,i);
Close(f);
End.
Задание13. Дано слово удвоить его каждую букву и записать его в текст. файл
Program as;
Uses crt;
Var f:text; a:string; I,s:integer;
Readln(a);
For i:=1 to length (a)*2 do begin insert
Copy(a,I,1),a,i);
I:=i+1;
End;
Writeln(f,a);
Close(f);
End.
Задание14. Имеется текстовый файл посчитать кол-во строк начинающихся на букву М
Program as;
Uses crt;
Var F:text; a:string; k:integer;
Begin clrscr;
Assign(f,’abc.txt’);
Reset(f);
While not(Eof(f)) do begin
readln(f,a);
if copy(a,1,1)=’М’ then k:=k+1;
end; close(f);
writeln(k);
end.
Задание 15. Создать текстовый файл и записать в него 6 одинаковых чисел
Program as;
Uses crt;
Var F:text; a:string; i:integer;
Begin clrscr;
Assign (f,’text.txt’);
Rewrite (f);
For i:=1 to 6 do
Writeln(f,6);
Close(f);
End.
Записи в Паскале
Задание 1. Составить список учебной группы, включающей 25 человек. Для каждого учащегося указать дату рождения, год поступления в техникум, курс, группу, оценки каждого года обучения. Информацию о каждом учащемся оформить в программе в виде записи. Совокупность записей объединить в массив.
Составить программу, которая обеспечивает ввод полученной информации, распечатку ее в виде таблицы, а также распечатку информации о отличниках
Program Pascal;
Uses crt;
type student=record
fio: string;
d_r:1..31; {день рождения}
m_r:1..12; {месяц рождения}
god_r:1965..1975; {год рождения}
god_p:2004..2008; {год поступления}
group:string; {название группы}
ocenki:array[1..3,1..5] of integer; {оценки по трем предметам}
end;
var
s1: array[1..25] of student;
i,j,x:integer;
ch:char;
f:boolean;
begin
clrscr;
for i:=1 to 25 do begin
writeln('Сведения о ',i,' студенте');
with s1[i] do begin
write('ФИО:');readln(fio);
write('Дата рождения:.. г.');
x:=wherex;
gotoxy(x-13,wherey); read(d_r);
gotoxy(x-10,wherey-1); read(m_r);
gotoxy(x-7,wherey-1); read(god_r);
if keypressed then begin
ch:=readkey;
if ch=#0 then ch:=readkey;
end;
write('Год поступления: ');readln(god_p);
write('Группа: ');readln(group);
j:=0;
for i:=god_p to 2008 do begin
j:=j+1;
writeln('Оценки за ',i,' год:');
write('Математика: ');readln(ocenki[1,j]);
write('Информатика: ');readln(ocenki[2,j]);
write('История: ');readln(ocenki[3,j]);
end;
end;
writeln;
end;
writeln('список отличников');
for i:=1 to 25 do begin
with s1[i] do begin
j:=0;
f:=true;
for i:=god_p to 2008 do begin
j:=j+1;
if not((ocenki[1,j]=5) and (ocenki[1,j]=5) and (ocenki[1,j]=5)) then f:=false;
end;
if f=true then writeln(fio,', группа ',group,', год поступления ',god_p);
end;
end;
writeln('Для выхода нажмите Enter');
readln;
end.
Задание 2. Разработать программу формирования файла, содержащего сведения о студентах. Каждый элемент этого файла должен содержать следующие данные: номер группы; номер в группе по списку; фамилию, имя, отчество; год рождения; оценки за последнюю сессию
Program Pascal;
Uses crt;
Const fname='students.dat';
n=5; {количество предметов за последнию сессию}
Type st=record
n_group:integer; {номер группы}
n_sp:integer; {номер в группе по списку}
fam:string; {фамилия}
im:string; {имя}
ot:string; {отчество}
god_r:integer; {год рождения}
oc:array [1..n] of integer; {оценки за последнию сессию}
end;
Var t:array[1..30] of st;
i,ch,j:integer;
h: file of st;
begin
write('Введите количество студентов в группе: '); readln(ch);
for i:=1 to ch do begin
writeln('Сведения о ',i,' студенте');
write('Номер группы: '); readln(t[i].n_group);
write('Номер в группе по списку: '); readln(t[i].n_sp);
write('Фамилия: '); readln(t[i].fam);
write('Имя: '); readln(t[i].im);
write('Отчество: '); readln(t[i].ot);
write('Год рождения: '); readln(t[i].god_r);
writeln('Оценки за последнию сессию: ');
for j:=1 to n do begin
case j of
1:write('Математика: ');
2:write('Физика: ');
3:write('Химия: ');
4:write('Культурология: ');
5:write('История: ');
end;
readln(t[i].oc[j]);
if not ((t[i].oc[j]>0) and (t[i].oc[j]<=5)) then begin
writeln('Неверно введена оценка! Повторите ввод.');
j:=j-1;
end;
end;
writeln;
end;
Assign (h,fname);
{$I-}
reset(h);
If Ioresult<>0 then rewrite(h);
{$I+}
for i:=1 to ch do write(h,t[i]);
close(h);
writeln('Данные занесены в файл ',fname);
readln;
end.
Задание 3. В ГИБДД имеется следующая информация об автомобилях и их владельцах:
а) марка машины;
б) номер машины;
в) Фамилия владельца.
Необходимо организовать поиск количества автомобилей определенной марки. Информацию об автомобилях и их владельцах оформить в виде записей, хранимых в файле. Ввод данных в запись и сохранение записи в файле
Program N10_1;
Uses Crt;
Const fname='spisok.dat';
{Имя файла, в который будет производиться запись}
Type Person=record
marka:string;
number:string;
familia:string;
end;
Var auto:array[1..5] of person;
i:integer;
h: file of person;
begin
Clrscr;
auto[1].marka:='Мерседес';
auto[1].number:='235';
auto[1].familia:='Иванов';
auto[2].marka:='Мерседес';
auto[2].number:='289';
auto[2].familia:='Петров';
auto[3].marka:='Волга';
auto[3].number:='365';
auto[3].familia:='Сидоров';
auto[4].marka:='Жигули';
auto[4].number:='896';
auto[4].familia:='Кузнецов';
auto[5].marka:='Вольво';
auto[5].number:='957';
auto[5].familia:='Тимофеев';
Assign (h,fname);
{$I-}
reset(h);
If Ioresult<>0 then rewrite(h);
{$I+}
for i:=1 to 5 do begin
write(h,auto[i]);
end;
writeln('Данные занесены в файл ',fname);
write('Нажмите Enter');
readln;
end.
Выполнение задания
Program N10_2;
Uses Crt;
Const fname='spisok.dat';
Type Person=record
marka:string;
number:string;
familia:string;
end;
Var auto:array[1..5] of person;
i,j,l,q:integer;
h: file of person;
s:string;
f:boolean;
begin
Clrscr;
Assign (h,fname);
Reset (h);
i:=0;
While Eof (h) = false do begin
i:=i+1;
Read(h,auto[i]);
end;
Close(h);
writeln('Информация, считанная из файла ',fname);
writeln;
q:=i;
for j:=1 to q do begin
with auto[j] do begin
gotoxy(1,wherey);
write(marka);
gotoxy(15,wherey);
write(number);
gotoxy(20,wherey);
writeln(familia);
end;
end;
writeln;
write('Введите интересующую Вам марку автомобиля: ');
readln(s);
writeln;
l:=0;
for j:=1 to q do begin
with auto[j] do begin
if marka=s then begin
l:=l+1;
gotoxy(1,wherey);
write(number);
gotoxy(10,wherey);
writeln(familia);
end;
end;
end;
writeln('Количество автомобилей данной марки - ',l);
write('Нажмите Enter');
readln;
end.
Задание 4. На телефонном узле в конце каждого квартала составляется на каждого абонента ведомость оплаты междугородных телефонных разговоров (с 7-ю городами) в течение квартала (3 месяца)
Написать программу, которая вводит исходные данные, выполняет расчеты и выводит на экран:
ü Исходные данные в виде таблицы, где указаны коды городов, с которыми велись разговоры, общее время разговора с каждым городом за один месяц, стоимость одной минуты разговора (меняется каждый месяц);
ü Общая продолжительность разговоров с каждым городом за квартал;
ü Плата за каждый месяц;
ü Общая плата за 3 месяца;
ü Город с наибольшей платой.
program kursovik;
uses crt;
type
telef=record
kod:integer;
tpm1,tpm2,tpm3,price1,price2,price3:integer;
end;
telef1=record
kod,tpm,ob:integer;
pr1,pr2,pr3:integer;
end;
var
a:file of telef;
res:array[1..7] of telef1;
i,j,s,aa,max:integer;
begin;
textbackground(10);
clrscr;
textcolor(0);
gotoxy(15,2);
writeln('Курсовая работа студента группы 01М22 Белоусовой Е.В.');
gotoxy(27,3);
writeln('Задание на курсовую работу:');
textcolor(4);
writeln;
writeln(' На телефонном узле в конце каждого квартала составляется на каждого абонента');
writeln('ведомость оплаты междугородных телефонных разговоров (с 7-ю городами) в течение');
writeln('квартала (3 месяца).');
writeln(' Написать программу, которая вводит исходные данные, выполняет расчеты и ');
writeln('выводит на экран:');
writeln(' - исходные данные в виде таблицы, где указаны коды городов, с которыми велись');
writeln(' разговоры, общее время разговора с каждым городом за один месяц, стоимость');
writeln(' одной минуты разговора (меняется каждый месяц);');
writeln(' - общая продолжительность разговоров с каждым городом за квартал;');
writeln('плата за каждый месяц;');
writeln('общая плата за 3 месяца;');
writeln('город с наибльшей платой.');
gotoxy(27,18);
textcolor(0);
writeln('Требование к вводу информации');
textcolor(4);
writeln(' - исходные данные вводятся с клавиатуры.');
textcolor(0);
writeln;
writeln(' Требование к выводу результатов');
textcolor(4);
writeln(' - результат выводятся на экран.');
textcolor(14);
writeln;
writeln(' Для продолжения работы программы нажмите ENTER');
readln;
clrscr;
textcolor(0);
writeln(' Требования к структуре программы ');
textcolor(4);
writeln(' Программа должна состоять из следующих частей:');
writeln(' - вывод заставки с информацией о студенте и задании;');
writeln(' - ввод данных (выполняется в диалоговом режиме);');
writeln(' - вывод исходных данных и результатов (на один экран).');
textcolor(0);
writeln(' Требования к размещению исходных данных внутри программы ');
textcolor(4);
writeln(' Исходные данные располагаются в файле, компонентами которого являются записи.');
writeln('Структура каждой записи и типы ее полей выбираются в зависимости от задания.');
textcolor(0);
writeln(' Используемые цвета ');
textcolor(4);
writeln(' - черный(0),красный(4), светло-зеленый(10), желтый(14)');
textcolor(14);
gotoxy(18,24);
writeln('Для продолжения работы программы нажмите ENTER');
readln;
clrscr;
assign(a,'kurs.dat');
rewrite(a);
textcolor(0);
for i:=1 to 7 do
begin
write('Введите код ',i,'-го города: ');
readln(tel.kod);
write('Введите общее время разговора с городом ',tel.kod,' за 1-й месяц: ');
readln(tel.tpm1);
write('Введите стоимость одной минуты разговора с городом ',tel.kod,' в 1-м месяце: ');
readln(tel.price1);
write('Введите общее время разговора с городом ',tel.kod,' за 2-й месяц: ');
readln(tel.tpm2);
write('Введите стоимость одной минуты разговора с городом ',tel.kod,' в 2-м месяце: ');
readln(tel.price2);
write('Введите общее время разговора с городом ',tel.kod,' за 3-й месяц: ');
readln(tel.tpm3);
write('Введите стоимость одной минуты разговора с городом ',tel.kod,' в 3-м месяце: ');
readln(tel.price3);
write(a,tel);
end;
close(a);reset(a);
s:=1;
while not eof(a) do begin
read(a,tel);
res[s].kod:=tel.kod;
res[s].tpm:=tel.tpm1+tel.tpm2+tel.tpm3;
res[s].pr1:=tel.tpm1*tel.price1;
res[s].pr2:=tel.tpm2*tel.price2;
res[s].pr3:=tel.tpm3*tel.price3;
res[s].ob:=res[s].pr1+res[s].pr2+res[s].pr3;
s:=s+1;
end;close(a);
clrscr;
writeln('Код города Общее время разговора за каждый месяц Стоимость минуты разговора');
reset(a);
while not eof(a) do
begin
read(a,tel);
writeln(' ',tel.tpm1,' ',tel.price1);
writeln(' ',tel.kod,' ',tel.tpm2,' ',tel.price2);
writeln(' ',tel.tpm3,' ',tel.price3);
end;
textcolor(14);
gotoxy(18,24);
writeln('Для продолжения работы программы нажмите ENTER');
readln;
clrscr;
textcolor(0);
writeln('Код города Общее время разговора за квартал Плата за месяц Общая плата');
for i:=1 to 7 do
begin
aa:=res[i].kod;
writeln(' ',res[i].pr1);
writeln(' ',aa,' ',res[i].tpm,' ',res[i].pr2,' ',res[i].ob);
writeln(' ',res[i].pr3);
end;
max:=res[1].ob;
for i:=1 to 6 do begin
if res[i+1].ob>max then
begin
max:=res[i+1].ob;
j:=i+1;
end;
end;
writeln('Город с наибольшей платой: ',res[j].kod);
textcolor(14);
gotoxy(18,24);
writeln('Для завершения работы программы нажмите ENTER');
readln;
end.
Задание 5 Упорядочить список студентов по среднему балу и распечатать его
Program spisok_grupp;
Uses Crt;
Const kurs=3;
Const kol=5;
Type
sved=record
famil:string[25];
datar:string[8];
god: integer;
gruppa: integer;
ocenki:array[1..3,1..5] of integer;
srball:array[1..25] of real;
End;
Var
spisok: array[1..25] of sved;
i,i1,j, s,mesto,n,g:integer;
max,t:real;
q:string[25];
Begin
ClrScr;
writeln('Введите количество учеников');
readln(n);
for i:=1 to n do
With spisok[i] do
Begin
Writeln ('Фамилия ',i,' студента');
Readln (famil);
Writeln('Дата рождения');
Readln (datar);
Writeln ('Год поступления');
Readln (god);
Writeln ('Группа');
Readln (gruppa);
s:=0;
for i1:=1 to kurs do
begin
writeln('Оценки ',i1,' года');
for j:=1 to kol do
Begin
Writeln (j,' Предмет');
Readln (ocenki[i1,j]);
s:=s+ocenki[i1,j];
End;
end;
srball[i]:=s/(kol*kurs);
ClrScr;
End;
writeln('Фамилия':8,'Дата рождения':16,'Год поступления':18,'Курс':7,'Группа':8);
for i:=1 to n do
begin
with spisok[i] do write(famil:8,datar:16,god:18,kurs:7,gruppa:8);
writeln;
writeln;
for g:=1 to kurs do
begin
write(g,' год:');
for j:=1 to kol do
with spisok[i] do write(ocenki[g,j]:4);
writeln;
end;
with spisok[i] do writeln('Средний бал =',srball[i]:6:2);
writeln;
end;
writeln;
writeln('По порядку');
for j:=1 to n do
Begin
max:=spisok[j].srball[j];
mesto:=j;
for i:=j to n do
if spisok[i].srball[i]<=max then
Begin
max:=spisok[i].srball[i];
mesto:=i;
End;
t:=spisok[j].srball[j];
spisok[j].srball[j]:=spisok[mesto].srball[mesto];
spisok[mesto].srball[mesto]:=t;
q:=spisok[j].famil;
spisok[j].famil:=spisok[mesto].famil;
spisok[mesto].famil:=q;
with spisok[j] do writeln(famil:8,srball[j]:6:2);
End;
End.
Задание 6. Запись с вариантами
var R = Record
rem: string;
Case byte of
3: (n:integer);
5: (x,y,z:char);
'a': (i,j:byte);
end;
begin
R.rem:='запись с ваpиантами';
R.n:=25000;
write(R.i,R.x,R.j,R.y); {168и97a}
{ord('и')=168, ord('a')=97, 168+97*256=25000}
end.
Задание 7. Пример объявления типа запись
type Men = Record
FIO,Adress: string;
Year: byte;
End;
var A,B: Men;
begin
A.FIO:='Иванов И.И.';
A.Adress:='пp. Ленина, д. 40, кв. 10';
A.Year:=1981;
end.
Задание 8. Составить программу в которой известны Фамилия, адрес и номера Телефонов 15 человек, организовать поиск номера телефона по фамилии абонента
Program as;
Type
person=record
surname: string[40]
adres: string[20]
nomer: integer
var
mas:array[1..15] of person;
i:integer; poisk: string;
procedure Input.date;
var
begin
writeln(‘Введи данные’,I,’ абонента’);
writeln(‘Фамилия’);
readln(mas[i].surname);
writeln(‘адрес’);
readln(mas[i].adres);
writeln(‘Номер телефона’);
readln(mas[i].nomer);
end;
Procedure write date;
Begin
With mas[i] do
Begin
Writeln(‘фамилия’,surname);
Writeln(‘адрес’,adres);
Writeln(‘номер’,nomer);
End;
End;
Begin
For i:=1 to 15 do Input.date;
Writeln(‘Введи фамилию абонента’);
Readln(poisk);
For i:=1 to 15 do
If mas[i] nomer=poisk then write date;
End.
Задание 9. Создать список учеников класса и вывести на экран Фамилии и Имена в виде таблицы
Program as;
Uses crt;
Type
Klass=record
Surname:string[15];
Name:string[10];
End;
Var A:array [1..10] of klass;
I:integer;
Begin clrscr;
For i:=1 to 10 do begin
Writeln(‘введи фамилию’);
Readln(a[i].surname);
Writeln(‘введи имя’);
Readln(a[i].name);
End;
Writeln;
Clrscr;
For i:=1 to 10 do writeln(a[i].surname,’ ‘,a[i].name);
End.
Задание10. Известны данные о 6 сотрудниках фирмы Фамилия, возраст, и отношение к воен.службе. Вывести на экран фамилии всех военнообязанных сотрудников
Program as;
Uses crt;
Type
S=record
N:string[10]; voz:integer;
V:string[8];
End;
Var a:array[1..6] of s;
I:integer;
Begin clrscr;
For i:=1 to 6 do begin
Writeln(‘какая у тебя фамилия’);
Readln(a[i].s);
Writeln(‘сколько тебе лет’);
Readln(a[i].voz);
Writeln(‘ты относешся к военной части’);
Readln(a[i].v);
End; Writeln; Clrscr;
For i:=1 to 6 do if a[i].v=’DA’ then writeln(a[i].s);
End.
Задание11. Даны названия 6 городов и стран, среди них есть город находящийся в Италии напечатать их название
Program as;
Uses crt;
Type
S=record
strana: string[10];
gorod:string[8];
End;
Var a:array[1..6] of s;
I:integer;
Begin clrscr;
For i:=1 to 6 do begin
Writeln(‘страна?’);
Readln(a[i].strana);
Writeln(‘город’);
Readln(a[i]. gorod);
End; Writeln; Clrscr;
For i:=1 to 6 do if a[i]. strana =’italia’ then writeln(a[i].gorod);
End.
Задание12. Даны названия 10 стран и частей света. Напечатать на экране все страны находящиеся в Азии
Program as;
Uses crt;
Type
S=record
strana: string[10];
ch:string[8];
End;
Var a:array[1..10] of s;
I:integer;
Begin clrscr;
For i:=1 to 10 do begin
Writeln(‘страна’);
Readln(a[i].strana);
Writeln(‘часть света’);
Readln(a[i]. ch);
End; Writeln; Clrscr;
For i:=1 to 10 do if a[i]. ch =’Azia’ then writeln(a[i]. strana);
End.
Задание13. Из ведомости 3-х студентов с их оценками (порядковый номер, Ф.И.О. и три оценки) определить количество отличников и средний бал каждого студента
Program Spic;
Type wed = record {Тип wed включает 3 поля: n, fio, bal}
n: integer;
fio: string[40];
bal: array [1..3] of integer {Поле bal – массив из 3 оценок }
end;
Var spisok: wed; {Запись spicok типа wed}
i, j, kol, s: integer; sr: real;
Begin
kol:=0; {kol- количество отличников}
With spisok do {with присоединяет имя записи spisok ко всем }
For i:=1 to 3 do { полям внутри цикла For по i }
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.
Задание14. Пусть нам необходимо заполнить сведения о студенте (Ф.И.О., дата рождения, адрес, курс и группа), а затем вывести эти сведения на экран
program primer1;
type anketa=record
fio: string[45];
dat_r: string[8];
adres: string[50];
curs: 1..5;
grupp: string[3]
end;
var student: anketa;
begin
writeln (‘введите сведения о студенте’);
{обратите внимание, ввод каждого поля осуществляется отдельно}
writeln (‘введите фамилию, имя и отчество’);
readln (student.fio);
writeln (‘введите дату рождения’);
readln (student.dat_r);
writeln (‘введите адрес’);
readln(student.adres);
writeln (‘введите курс’);
readln(student.curs);
writeln (‘введите группу’);
readln (student.grupp);
writeln (‘ввод закончен’);
writeln;
{обратите внимание, что вывод записи осуществляется по полям}
writeln (‘фамилия студента: ’, student. fio);
writeln(‘ дата рождения: ’, student.dat_r);
writeln(‘ адрес: ’, student.adres);
writeln(‘ курс: ’, student.curs);
writeln(‘ группа: ’, student.grupp);
end.
Задание15. Пусть нам необходимо иметь сведения о многих студентах, например, нашего факультета. Следовательно, необходимо организовать массив записей Паскаля. А затем из общего списка вывести фамилии студентов 2-го курса
program primer 2;
type anketa=record
fio: string[45];
dat_r: string[8];
adres: string[50];
curs: 1..5;
grupp: string[3]
end;
var student: array [1..100] of anketa;
I: integer;
begin
{последовательно вводим каждую запись}
for I:=1 to 100 do
begin
writeln (‘введите сведения о’, I, ‘-м студенте’);
writeln (‘введите фамилию, имя и отчество’);
readln (student[I].fio);
writeln (‘введите дату рождения’);
readln (student[I].dat_r);
writeln (‘введите адрес’);
readln(student[I].adres);
writeln (‘введите курс’);
readln(student[I].curs);
writeln (‘введите группу’);
readln (student[I].grupp);
end;
writeln (‘ввод закончен’);
writeln;
{просматриваем массив записей и выбираем только студентов 2-го курса }
for I:=1 to 100 do
if student[I].curs=2 then
writeln(‘ фамилия студента: ’, student[I].fio);
end.
СтрокиЗадание 1. Дана последовательность слов. Напечатать те слова последовательности, которые отличны от последнего слова и удовлетворяют свойству: слово симметрично
Program Stroki;
Uses Crt;
Var s,k:string;
a:array[1..100] of string;
i,n,j,l:Integer;
f:boolean;
begin
ClrScr;
{Ввод последовательности слов}
Writeln('Введите последовательность слов:');
Readln(s);
{Запись слов в массив a}
for i:=1 to length(s) do begin
if (s[i-1]<>' ') and (s[i]=' ') and (length(k)<>0) then begin
inc(n);
a[n]:=k;
k:='';
end;
if s[i]<>' ' then k:=k+s[i];
if (i=length(s)) and (length(k)<>0) then begin
inc(n);
a[n]:=k;
k:='';
end;
end;
{Проверка на симметричность слов, содержащихся в массиве а}
l:=0;
for i:=1 to n-1 do begin
f:=false;
if a[i]<>a[n] then
if length(a[i]) mod 2 = 0 then begin
for j:=1 to length(a[i]) div 2 do
if a[i][j]<>a[i][length(a[i])+1-j] then f:=true;
if f=False then begin
l:=l+1;
if l=1 then Write('Симметричные слова: ');
Write(a[i],' ');
end;
end;
end;
Writeln;
if l=0 then Writeln('Симметричные слова отсутствуют');
Write('Нажмите Enter');
Readln;
end.
Задание 2. Дана строка символов. Преобразовать эту строку удалив из нее каждые ">>" и повторив (вставив еще раз) каждую пару символов "<<". После преобразования полученную строку вывести на печать
Program Stroki;
Uses Crt;
Var s:string;
i:integer;
begin
ClrScr;
Write('Введите строку символов: ');
Readln(s);
for i:=1 to length(s) do begin
if (s[i-1]='>') and (s[i]='>') then delete(s,i-1,2);
if (s[i-1]='<') and (s[i]='<') then begin
insert('<<',s,i-1);
i:=i+2;
end;
end;
Writeln('Преобразованная строка: ',s);
Write('Нажмите Enter');
Readln;
end.
Задание 3. Составить программу, которая запрашивает имя человека и повторяет его на экране с Приветствием
Program as;
Uses crt;
Var K:string;
Begin clrscr;
Writeln(‘Как вас зовут’);
Readln(k);
Writeln(‘Привет,’ ‘,k’!’);
End.
Задание 4. Составить программу, которая запрашивает название футбольной команды и повторить его на экране со словом «Это чемпион!»
Program as;
Uses crt;
Var k:string;
Begin clrscr;
Writeln(‘Введите название футб. команды’);
Readln(k);
Writeln(k,’ ’,’Чемпион!’);
End.
Задание 5. Дана строка символов s1,s2,...sn, в которой встречаются цифры, пробелы, буква Е и знаки + и -. Известно, что первый символ строки является цифрой. Из данной строки выделить подстроку предшествующую первому пробелу. Требуется: определить является ли это подстрока числом, если да, то выяснить целым или вещественным, положительным или отрецательным
Program Stroki;
Uses Crt;
Var s1,s2:string;
i:Integer;
k:Real;
f:boolean;
begin
ClrScr;
Writeln('Введите строку символов:');
Readln(s1);
s2:='';
f:=true;
for i:=1 to length(s1) do begin
if s1[i]=' ' then f:=false;
if (s1[i]<>' ') and (f=true) then s2:=s2+s1[i];
end;
Writeln('Выделенная подстрока: ',s2);
Val(s2,k,i);
if i<>0 then Writeln('Выделенная подстрока не содержит числовое значение')
else begin
f:=false;
for i:=1 to length(s2) do
if s2[i]='E' then begin
Write('Число в подстроке вещественного типа, ');
f:=true;
end;
if f=false then Write('Число в подстроке целочисленного типа, ');
if k<0 then Writeln('отрицательное')
else Writeln('положительное')
end;
Write('Для выхода нажмите Enter');
Readln;
end.
Задание 6. Дано название футбольного клуба, определить кол-во символов в нем
Program as;
Uses crt;
Var k:string; M:integer;
Begin clrscr;
Writeln(‘Введите название Ф.К’);
Readln(k);
M:=length(k);
Writeln(M);
End.
Задание 7. Дано название города, определить четно или нет, кол-во символов в нем
Program as;
Uses crt;
Var k:string;b:integer;
Begin clrscr;
A:=’Aktobe’;
B:=length(a);
If b mod 2=0 then write(‘четно ‘) else write(‘нечетно ‘);
Readln;
End.
Задание 8. Дана строка, содержащая текст. Записать её в обратном порядке
program з8;
var s1,s2: String;
i: Integer;
begin
Write('Введите строку=');
ReadLn(s1); s2:='';
for i:=Length(s1) downto 1 do s2:=s2+s1[i]; WriteLn('Обратная строка=',s2);
ReadLn; end.
Задание 9. Дано слово. Заменить «о» на «е»
Program as;
Uses crt;
Var a:string; e,I,b:integer;
Begin clrscr;
Writeln(‘Dano clovo’);
Readln(a);
B:=length(a);
For i:=1 to b do if copy(a,I,1)=’o’ then begin
Delete(a,I,1);
Insert(‘e’,a,i);
End;
Writeln(a);
End.
Задание10. Даны 2 фамилии опред какая из них длиннее
Program as;
Uses crt;
Var a,b:string; c,d:integer;
Begin clrscr;
A:=’kolin’;
B:=’imanalin’;
C:=length(a);
D:=:=length(b);
If c>d then write(a) else write(b);
End.
Графика в Турбо-Паскале
Задание 1. При нажатии на Enter плавно перемещает треугольник c вершинами (10,10);(10,100);(100,100) на 10 пунктов по X, и по Y
uses crt,graph;
const n=4;
type
Point=record
x,y:integer;
end;
mas=array[1..n] of Point;
procedure Z(x,y:integer;var m:mas;c:byte);
var i:byte;
begin
Setcolor(c);
m[1].x:=x;m[1].y:=y;
m[2].x:=x;m[2].y:=y+90;
m[3].x:=x+90;m[3].y:=y+90;
m[4].x:=x;m[4].y:=y;
moveto(m[1].x,m[1].y);
for i:=1 to n do
lineto(m[i].x,m[i].y);
Setfillstyle(1,c);
end;
var gd,gm:integer;
x,y,x1,y1,i:integer;
p:mas;
c1,c2:byte;
k:char;
move:boolean;
begin
gd:=VGA;
gm:=VGAHi;
Initgraph(gd,gm,'..\bgi');
Setbkcolor(8);
x:=10;y:=10;
c1:=7;c2:=8;
move:=true;
repeat
if keypressed then
begin
k:=readkey;
if k=#13 then {if enter}
for i:=1 to 10 do
begin
y1:=y;
x1:=x;
y:=y+1;
x:=x+1;
delay(6000);
Z(x1,y1,p,c2);
Z(x,y,p,c1);
move:=true;
end;
end;
if move then
begin
Z(x1,y1,p,c2);
Z(x,y,p,c1);
move:=false;
end;
OutTextXY(320,240,'Press Enter to continue');
until k=#27; {until escape}
closegraph;
end.
Задание 2. Изобразить на экране скачущий мяч. Использовать графический режим
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:\bp\bgi ');
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); repeat until keypressed;closegraph
floodfill(x,y,12); end.
Задание 3. Анимационная картинка - кораблик совершает путь по заданной траектории...все происходит довольно быстро
program corablik;
uses Graph, Crt;
var
grDriver: integer;
grMode: integer;
ErrCode: integer;
x,y,y0,a,b: integer;{a,b-переменные для линии моря, чтоб они не зависели от х,у}
procedure more(a,b:integer);
begin
moveto(0,y0);
setcolor(blue);
for a:=0 to 680 do{слева направо рисуем синусоиду синего чвета}
begin
b:=y0-round(sin(a*pi/180)*30);{30-коэффициент масштабирования по оси Х,
чем больше, тем волна круче}
lineto(a,b);
end;
end;
begin
grDriver:= Detect;
InitGraph(grDriver, grMode, '..\BGI');
ErrCode:= GraphResult;
y0:= 250;
if ErrCode = grOk then
begin
x:=600;
while x>=0 do{лучше использовать цикл while, можно менять величину шага,
что тоже влияет на скорость и частоту смены картинки}
begin
cleardevice;
more(a,b);{рисуем волну}
setcolor(white);{устанавливаем цвет кораблика}
y:=y0-40-round(sin(x*pi/180)*30);{движемся по волне}
MoveTo(x - 40, y + 20);
LineTo(x - 20, y + 40);
LineTo(x + 20, y + 40);
LineTo(x + 40, y + 20);
LineTo(x - 40, y + 20);
MoveTo(x + 15, y + 20);
LineTo(x + 15, y - 40);
LineTo(x - 20, y + 20);
LineTo(x + 15, y + 20);
delay(100); {нормальная скорость, если модули *.TPL не глючные как у Вас,
время должно быть в миллисекундах, а не в каких-нибудь наносекундах}
x:=x-2;{шаг движения}
end;
end
else Writeln('Graphics error: ', GraphErrorMsg(ErrCode));
Settextstyle(0,0,3);{устанавливаем стиль шрифта}
cleardevice;
setcolor(red);
OuttextXY(200,240,'Rejs zavershen!');{выводим надпись}
readln;
CloseGraph;
end.
Задание 4. Анимация - прямоугольничек красного цвета совершает полный путь по экрану монитора!
program kv;
uses
crt, graph;
var
x, y, dx, dy, w, h, driver, mode: integer;
begin
initgraph(driver, mode, 'G:/BP/BGI');
if graphresult<>0 then begin
writeln('none');
halt
end;
dx:=1;
dy:=0;
w:=100;
h:=10;
repeat
setfillstyle(1, black);
bar(x, y, x+w, y+h);
x:=x+dx;
y:=y+dy;
setfillstyle(1, red);
bar(x, y, x+w, y+h);
delay(100);
if (x+w>=getmaxx)and(y<=0) then
begin
dx:=0;
dy:=1;
end
else
if (y+h>=getmaxy)and(x+w>=getmaxx) then
begin
dx:=-1;
dy:=0;
end
else
if (x<=0)and(y+h>=getmaxy) then
begin
dx:=0;
dy:=-1;
end
else
if (y<=0)and(x<=0) then
begin
dx:=1;
dy:=0;
end;
until keypressed;
closegraph;
end.
Задание 5. Люди часто просят нарисовать самый обычный рисунок из разных тем...например нарисую"программиста"
Program bugalteria;
Uses crt,graph;
Var gd,gm:integer;
begin
clrscr;
Detectgraph (gd,gm);
Initgraph (gd,gm,'C:\tp7');
{Зарисовка стола}
Bar (120,330,360,360);
Bar (180,360,330,480);
{Зарисовка компьютера}
Line (180,240,180,330);
Line (180,270,210,330);
Line (172,210,202,300);
Line (180,210,210,300);
Line (210,300,202,300);
Line (180,210,172,210);
Line (270,322,270,330);
Line (270,322,330,330);
{Зарисовка стула}
Bar (420,405,510,420);
Bar (456,420,480,480);
{Зарисовка бухгалтера работающего за компьютером}
Line (510,405,540,300);
Line (334,480,390,390);
Line (390,390,510,390);
Line (360,480,420,405);
Line (510,390,450,240);
Line (480,390,420,300);
Line (420,300,430,240);
Line (450,270,330,300);
Line (330,300,310,310);
Circle (435,195,40);
Readln
end.
Задание 6. Построить один прямоугольник и заполнить его случайно расположенными точками (в пределах 100 штук) и второй прямоугольник в котором проведены случайные линии (различными цветами)
program пример;
uses graph, crt;
var gd,gm,xl,yl,x2,y2,x,y,x3,y3,i,errcode: integer;
begin
gd:=0; gm:=0;
InitGraph (gd,gm,’ ‘);
[построение первого прямоугольника]
x1:=10; y1:=10; x2:=200; y2:=200;
rectangle(x1,y1,x2,y2);
[вывод случайных точек]
for i:=1 to 100 do
begin
x:=random(x2-xl)+x1;
у:=random(y2-yl)+y1;
putpixel(x,y,2)
end;
[построение второго прямоугольника]
xl:=210; yl:=210; x2:=400; y2:=400;
rectangle(xl,yl, x2,y2);
[вывод случайных линий]
for i:=l to 100 do
begin
setcolor(random(15));
x:=random(x2-xl)+xl;
y:=random(y2-yl)+yl;
x3:=random(x2-xl)+xl;
y3:=random(y2-yl)+yl;
Iine(x,y,x3,y3);
end;
while not keypressed do;
closegraph
end.
Задание 7. Изобразить линии разного стиля и толщины
program пример;
[ вывод линий разного вида]
uses graph,crt;
var gd,gm: integer;
begin
gd:=0; gm:=0; initgraph (gd, gm, ' ');
line (0, 0, 300, 0); [линия обычного образца]
setlinestyle(l,0,l);line(0,20,300,20);[линия из точек]
setlinestyle(2,0,l);line(0,40,300,40);[пунктирная линия]
setlinestyle (3,0,1);line(0,60,300,60);[штриховая линия]
setlinestyle(0,0,3);line(0,80,300,80);[сплошная толстая линия]
while not keypressed do;
closegraph end.
Задание 8. Построить окружность и описать вокруг нее квадрат
program пример;
[квадрат и вписанная окружность]
uses graph, crt;
var gd,gm,x,y,r,x1,y1,x2,y2: integer; xa,ya:word;
begin
writeIn (‘введи координаты центра окружности и радиус’);
readln(x,y,r);
gd:=0; gm:=0; initgraph(gd,gm, ‘ ‘);
circle(x, у, г);
getaspectratio(xa,ya);
x1:= x-r; у1:= round (y -r*(xa/ya));
x2:=x+r; y2:= round (y+r*(xa/ya));
rectangle(xl,yl,x2,y2);
while not keypressed do;
closegraph end.
Задание 9. Построить дугу от 0 до 90 градусов и от 270 до 450 градусов
program пример;
[дуги окружности от 0 до 90 и от 270 до 450]
uses graph,crt;
var gd,gm,x,y,r,xl,yl: integer; xа,уа:word;
begin
gd:=0; gm:=0; initgraph(gd,gm,’ ‘);
getaspectratio(xa,ya);
{строим оси координат}
line(0,100,300,100); line(150,0,150,200);
{ строим дугу от 0 до 90 }
агс(150,100,0,90,40);,
line (310, 100,610,100); line(460,0,460,200);
{ строим дугу от 270 до 450 }
arc(460,100,270,540,40);
while not keypressed do; end.
Задание10. Построить дуги элипсов
program пример;
[дуги эллипсов при разном соотношении Rx и Ry]
uses graph,crt;
var gd,gm:integer; xa,ya:word;
begin
gd:=0; gm:=4; initgraph (gd, gm, ‘ ‘);
getaspectratio(xa, ya);
{ первая дуга}
line(0,100,l60,100);
line(80, 55, 80,145);
ellipse(80,100,180, 90,40,40);
{ вторая дуга}
line(190,100,410,100);
line(300,55,300, 145);
ellipse(300, 100, 0, 359,100,20);
{ третья дуга}
line(440,100,600,100);
line(520,55,520,145);
ellipse (520, 100, 0,270,40, round (40* (xa/ya)));
while not keypressed do; end.
Задание11. Построить прямоугольники в два ряда по четыре прямоугольника в ряд и заполнить их соответственно 12-ю различными типами штриховки
program пример;
{демонстрация цветов заполнения}
uses graph,crt;
var gd,gm,x,y,k, j:integer;
begin
gd:=0; gm:=0; initgraph (gd, gm, ' ');
x:=60; y:=40;
for j:=0 to 2 do
for k:=0 to 3 do
begin
rectangle ((k + 1) *x,(j+1)*y, (k+2)*x, (j+2)*y);
setfillstyle{k+j*4, j+1);
bar((k+1)*x+1, (j+1)*y+1, (k+2)*x-1, (j+2)*y-1)
end;
while not keypressed do;
end.
Задание12. Построить окружность и описать вокруг нее квадрат,а затем область внутри квадрата, но вне окружности закрасить цветом фона
program пример;
{ квадрат и вписанная окружность}
uses graph,crt;
var gd, gm, x, y, r,xl,yl,x2,y2: integer; xa,ya:word;
begin
writeln('введи координаты центра окружности и радиус’);
readln (х,у,г);
gd:=0; gm:=0; initgraph (gd, gm, ‘ ‘);
setcolor(3); circle(x, y, r);
getaspectratio(xa,ya);
x1:=x-r; yl:=round(у-r*(xa/ya));
x2:=x+r; y2:=round(y+r*(xa/ya));
rectangle(x1,y1,x2,y2);
floodfill(x1+1,y1+1,3);
floodfill(x2-1,y1+1,3);
floodfill(x1+1,y2-1,3);
floodfill(x2-1,y2-1,3);
while not keypressed do;
closegraph
end.
Задание13. Вывести точечным шрифтом горизонтально, начиная с точки (100,20), сообщение "horisontal (горизонтально)" и прямым шрифтом вывести вертикально сообщение "vertical (вертикально)", начиная с точки (5,10)
program пример;
{ графика и текст}
uses graph,crt;
var gd,gm: integer;
begin
gd:=0; gm:=0; initgraph(gd,gm, ‘ ‘);
outtextxy(100,20, ‘horisontal (горизонтально)’);
settextstyle(0,1,1);
outtextxy (50,10, ‘vertical (вертикально)’);
while not keypressed do;
end;
Задание14. Изобразить треугольник, вращающийся вокруг одной из вершин
program пример;
{ вращение треугольника вокруг одной вершины}
uses graph,crt;
var
gd,gm,I,xc,yc,x1,y1,x2,y2,x1n,x2n,y1n,y2n:integer;
xa,ya:word; t: real;
begin
gd:=9; gm:=2; initgraph (gd, gm, ‘ ‘);
getaspectratio(xa,ya);
xc:=300; yc:=100; t:=0; x1:=400; y1:=10; x2:=500;
y2:=100;
for i:=0 to 360 do
begin
t:=t+pi/180;
xln:=round (xc+ (xl-xc) *cos (t)+(yl-yc)*sin(t) *ya/xa);
у1n:=round (yc+ (yl-yc) *cos (t) - (xl-xc)*sin(t) *xa/ya);
x2n:=round (xc+(x2-xc) *cos(t)+(y2-yc)*sin(t) *ya/xa);
y2n: =round (yc+ (y2-yc) *cos (t) + (x2-xc)*sin(t) *xa/ya);
setcolor (15);
line (xc,yc, xln, yln); line (xln,yln,x2n,y2n);
line (x2n,y2n,xc,yc); delay(20);
setcolor(0);
line(xc,yc,xln,yln); line (xln,yln,x2n,y2n);
Iine(x2n,y2n,xc,yc); delay(20);
end; while not keypressed do;
closegraph
end.
Задание15. Изобразить движение шара(точнее круга)по горизонтали
program пример;
{ движение шара по горизонтали}
uses qraph,crt;
var gd,gm,i: integer; p:pointer; s:word;
begin;
gd:=0; gm:=0; initgraph (gd, gm, ‘ ‘);
{ рисуем шар}
for i:=l to 10 do circle (20, 30, i);
{ выделяем память}
s:=imagesize(9, 20,30, 40); getmem(p,s);
{ запоминаем рисунок}
getimage(9, 20, 30, 40,p^); cleardevice;
{ изображаем полет шара }
for i:=l to 600 do
begin putimage(10+i, 100,p^,0); delay(10); end;
while not keypressed do;
end.