АКТЮБИНСКИЙ ПОЛИТЕХНИЧЕСКИЙ КОЛЛЕДЖ

ОТЧЕТ

ПО УЧЕБНОЙ ПРАКТИКЕ

Выполнил: Журмухамедов Марат

Проверила: Гайсагалеева Б.М.

АКТОБЕ 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);

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;

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;

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;

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веди х(литры),р(плотность)молока ');

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;

writeln('Высота цилиндра=',H);

readln;

end.

(Вводим значение 10,5)

Ответ: 2м

Задание 7.Дана длина куба а. Найти объем куба v и площадь его боковой поверхности s.

program as;

uses crt;

var v,s,a:real;

begin clrscr;

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;

d:=c/2;

y:=sqr(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;

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;

writeln('Число единиц в нем=',d);

readln;

end.

(Вводим значение 6)

Ответ: единиц=6

Задание11.Дано расстояние в сантиметрах. Найти число полных метров в нем.

program as; Блок-схема

uses crt;

var a,m:integer;

begin clrscr;

writeln('Введи расстояние в сантиметрах');

readln(a);

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веди значение х ');

readln(x);

y:=7*(sqr(x))-3*x+6;

writeln('Y=',y);

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;

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');

readln(x,b);

z:=x*x*x*x*x;

s:=b*x;

v:=z+s;

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');

readln(h);

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);

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х зн. число’);

Readln(a);

D:=a div 10;

E:=a mod 10;

If d>e then max:=d else max:=e;

Writeln(‘Макс=’,max);

Readln;

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

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);

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);

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);

If a>b then max:=a else max:=b;

If max>c then max1:=max else max1:=c;

Writeln(‘Максимально=’,max1);

Readln;

End.

(Вводим значение 5,6,7)

Ответ: 7

Циклическая программа

Задание 1.Напечатать “столбиком”: все целые числа от 20 до 35

Program as; Блок-схема

Uses crt;

Var a:integer;

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;

Begin clrscr;

Writeln(‘Введи число’);

Readln(j);

For a:=10 to j do writeln(sqrt(a):5:2);

Readln;

end.

Задание 3.Найти сумму квадратов всех целых чисел от 10 до 50

Program as;

Uses crt;

Var a,s:real;

Begin clrscr;

For a:=10 to 50 do s:=sqr(a)+s;

Writeln(s);

end.

Задание 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.

(Вводим значение 4)

Ответ:256

Задание 6.Напечатать программу, печатающую таблицу значений функции y=cos2x на отрезке [0;1] с шагом h=0,1

Program as; Блок-схема

Uses crt;

Var y,x:real;

Begin clrscr;

X:=0;

While x<=1 do begin y:=cos(2*x);

Writeln(y:5:2);

X:=x+0,1;

End;

End.

Задание 7.Напечатать программу, вычисления факториала

Program as; Блок-схема

Uses crt;

Var i,n:integer;

f:real;

Begin clrscr;

Readln(n);

F:=1; i:=1;

While i<=n do begin f:=f*i;

i:=succ(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 n<1000 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 a<>b do if a>b then a:=a-b

Else 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:=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;

Begin clrscr;

S:=0;

Repeat write (‘Введи число’);

Readln(n);

S:=s+n;

Until n=0;

Writeln(‘S=’,s);

Readln;

End.

Задание12. Напечатайте 20 первых степеней числа 2

Program as; Блок-схема

Uses crt;

Var N,s:longint;

Begin clrscr;

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;

While x=5 do begin

N:=n+1;

Write(‘Введи оценку’);

Readln(x);

End;

Writeln(‘имеют отлично’,n,’учеников’);

End.

Задание14.Вывести на экран таблицу умножения.

Program as; Блок-схема

Uses crt;

Var I,j:integer;

Begin clrscr;

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;

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.