Редактирование и отладка программ с помощью 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);

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.Найти массу х литров молока, если известно, что плотность молока р кг/м³

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кг/м³)

Ответ: 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=2²*((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=7x²-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=x²+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.Решить пример -4x²+8,x<0

Y=

x² +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 оценок }