Редактирование и отладка программ с помощью Pascal
СОДЕРЖАНИЕ: Линейная программа на Паскаль, примеры составления алгоритмов вычисления и обмена значений переменных. Программа с ветвлениями и циклическая программа, массивы, процедуры и функции, файловые данные и записи в Паскале, строки, графика в Турбо-Паскале.АКТЮБИНСКИЙ ПОЛИТЕХНИЧЕСКИЙ КОЛЛЕДЖ
ОТЧЕТ
ПО УЧЕБНОЙ ПРАКТИКЕ
Выполнил: Журмухамедов Марат
Проверила: Гайсагалеева Б.М.
АКТОБЕ 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; y:=55*c;
writeln(y=,y);
|
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;
|
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);
|
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);
|
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веди х
(литры),р
(плотность)молока );
|
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);
|
writeln(Высота цилиндра=,H);
readln;
end.
(Вводим значение 10,5)
Ответ: 2м
Задание 7.Дана длина куба а . Найти объем куба v и площадь его боковой поверхности s .
 |
program as;
uses crt;
var v,s,a:real;
begin clrscr;
|
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);
|
|
y:=sqr(2)*d;
|
readln;
end.
(Вводим значение 5,5)
Ответ: 20
Задание 9.Известна длина окружности.Найти площадь круга, огранич. этой окружностью
program as; Блок-схема
uses crt;
var a,b:real;
begin clrscr;
writeln(Введи длину окужности);
readln(a);
|
writeln(Найти S круга=,b:5:2);
end.
(Вводим значение 5)
Ответ:78,5
Задание10. Дано натуральное число n(n9).Найти число единиц в нем
program as; Блок-схема
uses crt;
var a,d:integer;
begin clrscr;
writeln(Введи натуральное чисно);
readln(a);
|
writeln(Число единиц в нем=,d);
readln;
end.
 |
(Вводим значение 6)
Ответ: единиц=6
Задание11.Дано расстояние в сантиметрах. Найти число полных метров в нем.
program as; Блок-схема
uses crt;
var a,m:integer;
begin clrscr;
writeln(Введи расстояние в сантиметрах);
readln(a);
|
writeln(Получи расстояние в метрах,m);
readln;
end.
(Вводим значение 200)
Ответ: 2м
Задание12. Составить алгоритм вычисления y=7x2 -3x+6
program as; Блок-схема
uses crt;
var x,y:integer;
begin clrscr;
writeln(Bведи значение х );
|
y:=7*(sqr(x))-3*x+6;
writeln(Y=,y);
|
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);
|
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);
|
|
s:=b*x;
|
A:=v/2;
|
readln;
end.
(Вводим значение 2,3)
Ответ: 1.9
Задание15.Определить время падения камня на поверхность земли с высоты h.
program as; Блок-схема
uses crt;
var g,t,h:real;
begin clrscr;
writeln(Введи значение h);
|
t:=sqrt(2*h/g);
|
readln;
end.
(Вводим значение 10 м)
Ответ: 1,4278с
Программа с ветвлениями
Задание 1.Даны 2 целых числа, определить какое из них больше
Program as; Блок-схема
Uses crt;
Var a,b:integer;
Max:integer;
Begin clrscr;
Writeln(‘Введи 2 числа’);
Readln(a,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;
If de then max:=d else max:=e;
Writeln(‘Макс=’,max);
Readln;
|
|
 |
(Вводим значение 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,x0
Y=
x2 +3x+4,x0 Блок-схема
Program as;
Uses crt;
Var x,y:integer;
Begin clrscr;
Writeln(‘Введи аргумент x’);
Readln(x);
If x0 then Y:=-4*sqr(x)+8
|
|
writeln(‘Y=’,y);
readln;
end.
 |
Задание 8. Даны три вещественных числа a,b,c. Проверить выполняется ли неравенство abc.
program as; Блок-схема
uses crt;
var a,b,c:integer;
begin clrscr;
writeln(‘Введи три числа’);
readln(a,b,c);
if (ab) and (bc) 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 (a0) or (a0)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);
|
|
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);
|
c:=sqrt(b);
if (dc) 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 a5 then k:=a;
If b5 then z:=b;
If c5 then x:=c;
If d5 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);
|
|
If maxc then max1:=max else max1:=c;
Writeln(‘Максимально=’,max1);
Readln;
|
|
(Вводим значение 5,6,7)
Ответ: 7
 |
Циклическая программа
Задание 1.Напечатать “столбиком”: все целые числа от 20 до 35
Program as; Блок-схема
Uses crt;
Var a:integer;
|
For a:=20 to 35 do writeln(a);
Readln;
end.
 |
||
 |
||
 |
||
Задание 2.Напечатать “столбиком”: квадраты всех целых чисел от 10 до b (значение b вводится с клавиатуры, причем b10)
Program as; Блок-схема
Uses crt;
Var a,j:integer;
|
Writeln(‘Введи число’);
Readln(j);
For a:=10 to j do writeln(sqrt(a):5:2);
Readln;
end.
 |
|
||
 |
||
Задание 3.Найти сумму квадратов всех целых чисел от 10 до 50
 |
Program as;
Uses crt;
|
Begin clrscr;
For a:=10 to 50 do s:=sqr(a)+s;
Writeln(s);
|
 |
||
 |
||
 |
||
Задание 4.Одна штука некоторого товара стоит 20 тенге. Напечатать таблицу стоимости 2,3…20 штук этого товара
Блок-схема
Program as;
|
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;
|
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.
 |
 |
 |
|
Ответ:256
 |
 |
Задание 6.Напечатать программу, печатающую таблицу значений функции y=cos2x на отрезке [0;1] с шагом h=0,1
Program as; Блок-схема
Uses crt;
Var y,x:real;
|
X:=0;
While x=1 do begin y:=cos(2*x);
Writeln(y:5:2);
|
End;
End.
Задание 7.Напечатать программу, вычисления факториала
Program as; Блок-схема
Uses crt;
Var i,n:integer;
|
Begin clrscr;
Readln(n);
F:=1; i:=1;
While i=n do begin f:=f*i;
|
end;
Writeln(‘факториал от’,n,’равен’,f);
End.
Задание 8.Программа подсчета суммы S первых 1000 членов гармонического ряда 1+1/2+1/3+…1/N
Program as; Блок-схема
Uses crt;
|
Var s:real; N:integer;
Begin clrscr;
S:=0;N:=0;
While n1000 do begin N:=n+1;
S:=s+1/N;
End;
|
Writeln(s);
Readln;
End.
 |
|
 |
Задание 9.Вычислить наибольший общий делитель двух натуральных чисел А и В.
Program as; Блок-схема
Uses crt;
Var a,b:integer;
Begin clrscr;
writeln(‘Введи 2 натур. Числа’);
readln(a,b);
While ab do if ab then a:=a-b
Else b:=b-a;
|
|
Readln;
End.
 |
Задание10. Даны целые числа А и В (аb).Определить: Результат целочисленного деления А на В, не используя стандартную операцию целочисленного деления
Program as; Блок-схема
Uses crt;
Var a,b,n:integer;
Begin clrscr;
writeln(‘Введи 2 числа,ab’);
readln(a,b);
|
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;
Repeat write (‘Введи число’);
|
S:=s+n;
Until n=0;
Writeln(‘S=’,s);
Readln;
End.
Задание12. Напечатайте 20 первых степеней числа 2
Program as; Блок-схема
Uses crt;
Var N,s:longint;
|
|
Repeat s:=s*2;
Write(s,’ ‘);
N:=n+1;
Until n20;
Readln;
End.
 |
Задание13. Известны оценки по информатике 20 учеников класса. В начале списка перечислены все пятерки, затем все остальные оценки. Сколько учеников имеют по инфор-ке оценку «5»?
Program as; Блок-схема
Uses crt;
Var x,n:integer;
Begin clrscr;
Write(‘Введи оценку’);
Readln(x);
N:=0;
|
N:=n+1;
Write(‘Введи оценку’);
Readln(x);
End;
Writeln(‘имеют отлично’,n,’учеников’);
End.
Задание14.Вывести на экран таблицу умножения.
Program as; Блок-схема
Uses crt;
Var I,j:integer;
|
For i:=1 to 9 do
For j:=1 to 9 do writeln(I,*,j,’ ‘,i*j);
Readln;
|
End. Задание15.Составить программу, печатающую на экране все четные числа в диапазоне от 100 до 999.
Program as; Блок-схема
Uses crt;
Var a:integer;
|
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 20 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 20 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 xy 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 xy then max:=x else max:=y;
If maxz then max1:=max else max1:=z;
If xy then min:=x else min:=y;
If minz 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 xy do if xy 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 ab do if ab 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 kN then
begin
writeln(k,-й вызов процедуры);
k:=k+1;
Test;
end
else writeln(последний вызов процедуры);
end;
begin
read(N);
if N0 then Test;
end.
Задание 11. Вычислить N-е число Фиббоначчи
program Fib;
var n:byte;
function F(k:byte):word;
begin
if k2 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 xy do if xy 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 Ioresult0 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 Ioresult0 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].obmax 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 i0 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 k0 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 cd 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 n0 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 p0 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 graphresult0 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.