Программная реализация задач средствами алгоритмических языков

Частное учреждение образования

«Колледж бизнеса и права»

ОТЧЕТ по практике по программированию по дисциплине «Основы алгоритмизации и программирование»

Руководитель практики Н. И. Чембрович Учащийся С. А. Пикулик

1. Программа практики

1.1 Цели и задачи практики

1.2 Календарный график работы

2. Реализация индивидуального задания на практике

2.1 Вычислительная система

2.2 Инструменты разработки

2.3 Программирование на языке Паскаль в среде Турбо Паскаль

2.3.1 Линейный алгоритм

2.3.2 Использование процедур и функций

2.3.3 Использование массивов

2.3.4 Использование строк

2.3.5 Использование записей

2.3.6 Использование модулей

2.3.7 Использование рекурсии

2.3.8 Использование бинарного поиска

2.3.9 Использование сортировки включением

2.3.10 Использование обменной сортировки

2.3.11 Использование сортировки разделением

2.3.12 Использование динамической памяти

2.3.13 Использование списков

2.3.14 Создание базы данных в виде файла и их обработка

2.4 Программирование на языке Object Pascal в среде Delphi

Заключение

Литература Приложения

Учебная практика по профилирующим по специальности дисциплинам проводится с целью закрепления лекционного и лабораторно-практического материала. Перед учащимися ставится задача по реализации индивидуальных заданий средствами алгоритмических языков, таких как язык программирования высокого уровня Pascal в среде Turbo Pascal и язык Object Pascal в среде визуального программирования Delphi.

Для разработки программ необходимо использовать последовательность этапов, состоящих из:

— постановка задачи;

— математическое моделирование;

— алгоритмизация;

— программирование задачи;

— анализ результатов.

На этапе постановки задачи участвует человек, хорошо представляющий предметную область задачи. Он должен чётко определить цель задачи, дать словесное описание содержания задачи и предложить общий подход к её решению.

Цель этапа математического моделирования — создать такую математическую модель решаемой задачи, которая может быть реализована в компьютере. Существует целый ряд задач, где математическая постановка сводится к простому перечислению формул и логических условий.

Этап алгоритмизации задачи предполагает разработать алгоритм решения на основе математического описания.

Алгоритмом называется точное предписание, определяющее последовательность действий исполнителя, направленных на решение поставленной задачи. В роли исполнителей алгоритмов могут выступать люди, роботы, компьютеры.

Используются различные способы записи алгоритмов. Известны словесный способ записи, графическое представление в виде блок-схем.

Составление программы обеспечивает возможность выполнения алгоритма и поставленной задачи компьютером. Во многих задачах при программировании на алгоритмическом языке часто пользуются заменой блока алгоритма на один или несколько операторов, введением новых блоков, заменой одних блоков другими.

На этапе тестирования и отладки программы происходит исполнение алгоритма с помощью ПК, поиск и исключение ошибок. Отладка программы — сложный и нестандартный процесс. Исходный план отладки заключается в том, чтобы отладить программу на контрольных примерах.

Контрольные примеры стремятся выбирать таким образом, чтобы при работе с ними программа прошла все основные пути блок-схемы алгоритма. Сложные программы отлаживают отдельными фрагментами.

Этап выполнения отлаженной программы и анализа результатов предполагает запуск программы с заданными исходными данными, необходимых по условию задачи.

Полученные в результате решения выходные данные анализируются постановщиком задачи, и на основании этого анализа вырабатываются соответствующие решения, рекомендации, выводы.

1. Программа практики

1.1 Цели и задачи практики

Целями практики по основам алгоритмизации и программированию являются:

— закрепление знаний, связанных с разработкой программ на языке программирования высокого уровня Паскаль;

— приобретение навыков работы с интерфейсом интегрированной среды Турбо Паскаль и разработки программ в ней;

— приобретение навыков работы построения блок-схем алгоритмов;

— приобретение навыков работы с интерфейсом среды визуального программирования Delphi и разработки программ в ней;

— выработка умений применять средства стандартных библиотек в практических задачах.

Задачами практики по основам алгоритмизации и программированию являются:

— углублённое изучение способов и методов программирования;

— владение методами программирования;

— умение разрабатывать алгоритмы и составлять блок-схемы к ним.

1.2 Календарный график работы

Таблица 1 — Календарный график работы

2. Реализация индивидуального задания на практике

2.1 Вычислительная система

Конфигурация компьютера, на котором будут разрабатываться программы:

— процессор Intel i5 2.3 ГГц;

— оперативная память 6 Гб;

— жёсткий диск 1000 Гб.

2.2 Инструменты разработки

Инструментами разработки будут являться:

— среда программирования Turbo Pascal;

— среда визуального программирования Delphi;

— операционная система семейства Windows.

Turbo Pascal — это среда разработки для языка программирования Паскаль. Используемый в Turbo Pascal диалект базировался на более раннем UCSD Pascal, получившем распространение, в первую очередь, на компьютерах серии Apple II. Компилирующая компонента Turbo Pascal была основана на компиляторе Blue Label Pascal, первоначально созданном в 1981 году Андерсом Хейлсбергом для операционной системы NasSys микрокомпьютера Nascom. Позднее он был переписан как Compass Pascal для операционной системы CP/M, затем как Turbo Pascal для DOS и CP/M. Одна из версий Turbo Pascal была доступна под Apple Macintosh примерно с 1986 года, но её разработка прекратилась примерно в 1992 году.

Среда предназначена для быстрой (RAD) разработки прикладного ПО для операционных систем Windows, Mac OS X, а также IOS и Android. Благодаря уникальной совокупности простоты языка и генерации машинного кода, позволяет непосредственно, и, при желании, достаточно низкоуровнево взаимодействовать с операционной системой, а также с библиотеками, написанными на C/C++. Созданные программы не зависимы от стороннего ПО, как-то Microsoft.NET Framework, или Java Virtual Machine. Выделение и освобождение памяти контролируется в основном пользовательским кодом, что, с одной стороны, ужесточает требования к качеству кода, а с другой — делает возможным создание сложных приложений, с высокими требованиями к отзывчивости (работа в реальном времени). В кросс-компиляторах для мобильных платформ предусмотрен автоматический подсчет ссылок на объекты, облегчающий задачу управления их временем жизни.

Microsoft Windows — семейство проприетарных операционных систем корпорации Microsoft, ориентированных на применении графического интерфейса при управлении. Изначально Windows была всего лишь графической надстройкой для MS-DOS.

По состоянию на декабрь 2013 года под управлением операционных систем семейства Windows по данным ресурса Netmarketshare (Net Applications) работает около 90% персональных компьютеров^[1].

Операционные системы Windows работают на платформах x86, x86−64, IA-64, ARM. Существовали также версии для DEC Alpha, MIPS, PowerPC и SPARC^[2].

2.3 Программирование на языке Паскаль в среде Турбо Паскаль

программирование pascal массив файл

2.3.1 Линейный алгоритм

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, вычисляющую сумму, разность и произведение двух заданных элементов.

Составить словесное (математическое) описание и блок-схему следующей задаче: у треугольника АВС длины сторон а, в, с вводятся с клавиатуры. Найти длины высот. При неправильном вводе значений, вывести на экран сообщение об ошибке и предложением повторно ввести правильные данные. Результат отобразить на экране.

Формула вычисления периметра (2.1)

p=(a+b+c)/2 (2.1)

Формула вычисления стороны треугольника по трем точкам (2.2)

(2.2)

Блок-схема алгоритма решения задачи приведена в Приложении Б на рисунке Б.1.

Текст программы приведён в Приложении, А в листинге А.1.

Для тестирования программы использовались данные, приведённые в таблице 2. Полученные результаты приведены там же.

Таблица 2 — Результаты выполнения линейного алгоритма

Результат решения задачи представлен на рисунке 2.1

Рисунок 2.1 — Результат работы программы в Turbo Pascal

2.3.2 Использование процедур и функций

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, вычисляющую сумму, разность и произведение двух заданных элементов.

Составить словесное (математическое) описание и блок-схему следующей задаче: у треугольника АВС длины сторон а, в, с вводятся с клавиатуры. Найти длины высот. При неправильном вводе значений, вывести на экран сообщение об ошибке и предложением повторно ввести правильные данные. Результат отобразить на экране.

Формула вычисления периметра (2.3)

p=(a+b+c)/2 (2.3)

Формула вычисления стороны треугольника по трем точкам (2.4)

(2.4)

Блок-схема алгоритма решения задачи приведена в Приложении Б на рисунке Б.2.

Текст программы приведён в Приложении, А в листинге А.2.

Для тестирования программы использовались данные, приведённые в таблице 3. Полученные результаты приведены там же.

Таблица 3- Результаты выполнения линейного алгоритма

Результат решения задачи представлен на рисунке 2.2

Рисунок 2.2 — Результат работы программы в Turbo Pascal

2.3.3 Использование массивов

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется посчитать сумму четных строк заданного массива.

Дан двумерный массив размерностью 5×5. Вычислить сумму элементов, номера строк у которых четные. Формула вычисления суммы четных строк (2.5)

s := s + ar[i * 2, j] (2.5)

Блок-схема алгоритма решения задачи приведена в Приложении Б на рисунке Б.3.

Текст программы приведён в Приложении, А в листинге А.3.

Для тестирования программы использовались данные, приведённые в таблице 4. Полученные результаты приведены там же Таблица 4- Результат выполнения суммы четных строк массива

Результат решения задачи представлен на рисунке 2.3

Рисунок 2.3 — Результат работы программы в Turbo Pascal

2.3.4 Использование строк

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой нужно рассчитать количество слов в строке.

Дана строка, состоящая из русских слов, разделенных пробелами (одним или несколькими). Определить количество слов в строке.

Блок-схема алгоритма решения задачи приведена в Приложении Б на рисунке Б.4.

Текст программы приведён в Приложении, А в листинге А.4.

Для тестирования программы использовались данные, приведённые в таблице 5. Полученные результаты приведены там же.

Таблица 5- Результат выполнения подсчета слов в строке

Результат решения задачи представлен на рисунке 2.4

Рисунок 2.4 — Результат работы программы в Turbo Pascal

2.3.5 Использование записей

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется выполнить поиск по номеру телефона и фамилии.

Создать программу, обеспечивающую ввод, поиск по номеру квартиры и фамилии. Запись информацию о каждом: номер квартиры (тип integer), количество жильцов (тип integer), фамилия, имя, возраст (тип integer).

Текст программы приведён в Приложении, А в листинге А.5.

Для тестирования программы использовались данные, приведённые в рисунках.

Полученные результаты приведены там же.

Результат решения задачи представлен на рисунке 2.5

На рисунке 2.5 показано таблица жильцов дома Рисунок 2.5 — Результат работы программы в Turbo Pascal

На рисунке 2.6 показан поиск по фамилии жильца Рисунок 2.6 — Результат работы программы в Turbo Pascal

На рисунке 2.7 показан поиск по номеру квартиры Рисунок 2.7 — Результат работы программы в Turbo Pascal

2.3.6 Использование модулей

В заданном массиве A (N) вычислите среднее геометрическое и среднее арифметическое значения для положительных элементов Формула вычисления среднего арифметического 2.6

arif := arif + a[i] (2.6)

Формула вычисления среднего геометрического 2.7

geom := geom * a[i] (2.7)

Текст программы приведён в Приложении, А в листинге А.6.

Для тестирования программы использовались данные, приведённые в таблице 6. Полученные результаты приведены там же Таблица 6- Результат выполнения подсчета среднего арифм. и геометр.

Результат решения задачи представлен на рисунке 2.7

Рисунок 2.7 — Результат работы программы в Turbo Pascal

2.3.7 Использование рекурсии

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется вычислить последовательность n-го члена Составьте рекурсивную подпрограмму вычисления n-ого члена последовательности по рекуррентной формуле: x_i=(i+1)x_i-2; где x₁=1; x₂=0.3; i=3,4,…

Рекуррентная формула 2.8

X_i=(i+1)X_i-2, (2.8)

где x₁=1; x₂=0.3; i =3,4,…

Текст программы приведён в Приложении, А в листинге А.7.

Для тестирования программы использовались данные, приведённые в таблице 7. Полученные результаты приведены там же Таблица 7-Результат вычисления последовательности.

Результат решения задачи представлен на рисунке 2.8

Рисунок 2.8 -Результат работы программы в Turbo Pascal

2.3.8 Использование бинарного поиска

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется удалить из заданного массива элементы кратные 6.

Удалите из заданного массива A (N) элементы кратные шести. Выполнить вывод на печать полученного массива.

Текст программы приведён в Приложении, А в листинге А.8.

Для тестирования программы использовались данные, приведённые в рисунке 2.9. Полученные результаты приведены там же.

На рисунке 2.9 показан исходный массив и массив с удаленными элементами кратными 6.

Рисунок 2.9 -Результат работы программы в Turbo Pascal

2.3.9 Использование сортировки включением

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется в заданный массив AX (N) добавить массив C (K), далее выполнить сортировку включением и удалить элементы кратные шести.

Задан массив AX (N). Добавить массив С (К). Выполнить сортировку включением. В полученном векторе удалите элементы кратные шести. Выполнить вывод на печать полученного массива.

Текст программы приведён в Приложении, А в листинге А.9.

Для тестирования программы использовались данные, приведённые в таблице 8. Полученные результаты приведены там же.

Таблица 8- Сортировка включением

На рисунке 2.10 показан исходный массив и добавленный массив, далее показан отсортированный массив с удаленными элементами кратными 6.

Рисунок 2.10 -Результат работы программы в Turbo Pascal

2.3.10 Использование обменной сортировки

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется в заданный массив AX (N) добавить массив C (K), далее выполнить обменную сортировку и удалить элементы кратные шести.

Задан массив AX (N). Добавить массив С (К). Выполнить обменную сортировку. В полученном векторе удалите элементы кратные шести. Выполнить вывод на печать полученного массива.

Текст программы приведён в Приложении, А в листинге А.10.

Для тестирования программы использовались данные, приведённые в таблице 9. Полученные результаты приведены там же.

Таблица 9- Обменная сортировка

На рисунке 2.11 показан исходный массив и добавленный массив, далее показан отсортированный массив с удаленными элементами кратными 6.

Рисунок 2.11 -Результат работы программы в Turbo Pascal

2.3.11 Использование сортировки разделеением

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется в заданный массив AX (N) добавить массив C (K), далее выполнить сортировку разделением и найти наименьшее положительное значение.

Задан массив AX (N). Добавить массив С (К). Выполнить сортировку разделением. В полученном массиве, найти наименьший элемент из положительных значений.

Текст программы приведён в Приложении, А в листинге А.11.

Для тестирования программы использовались данные, приведённые в таблице 10. Полученные результаты приведены там же.

Таблица 10-Сортировка разделением

На рисунке 2.12 показан исходный массив и добавленный массив, далее показан отсортированный массив с нахождением наименьшего положительного значения.

Рисунок 2.12 -Результат работы программы в Turbo Pascal

2.3.12 Использование динамической памяти

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется заполнить массива случайными значениями, присвоить указателю адрес 4-ого элемента, напечатать его значение, используя текущий базовый адрес сегмента и смещение с преобразованием в значение типа указатель, а так же заменить его содержимое на значения 7-ого элемента, увеличенное в два раза.

Заполнить массив С (10) случайными значениями. Организовать вывод на экран. Присвоить указателю адрес начала размещения массива в памяти. Напечатать значения каждого третьего элемента массива. Присвоить указателю адрес 4-го элемента, напечатать его значение, используя текущий базовый адрес сегмента и смещение с преобразованием в значение типа указатель. Заменить его содержимое на значение 7-го элемента, увеличенное в два раза. Напечатать его новое значение.

Текст программы приведён в Приложении, А в листинге А.12.

Для тестирования программы использовались данные, приведённые на рисунке 2.13. Полученные результаты приведены там же.

Результат решения задачи представлен на рисунке 2.13

Рисунок 2.13 -Результат работы программы в Turbo Pascal

2.3.13 Использование списоков

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо решить задачу, в которой требуется создать связанный список из записей, содержащих сведения о бытовых товарах (код товара, наименование товара, цена товара), реализовать операции со связанным списком: запись первым в список, удаление первого объекта из списка, просмотр всего списка, удаление объекта, следующего за указанным.

Создать связанный список из записей, содержащих сведения о бытовых товарах (код товара, наименование товара, цена товара), реализовать операции со связанным списком: запись первым в список, удаление первого объекта из списка, просмотр всего списка, удаление объекта, следующего за указанным.

Текст программы приведён в Приложении, А в листинге А.13.

Для тестирования программы использовались данные, приведённые на рисунке 2.14. Полученные результаты приведены там же.

На рисунке 2.14 показан ввод записей в первый список Рисунок 2.14 -Результат работы программы в Turbo Pascal

На рисунке 2.15 показан весь список Рисунок 2.15 -Результат работы программы в Turbo Pascal

На рисунке 2.16 показано удаления первого объекта списка Рисунок 2.16 -Результат работы программы в Turbo Pascal

2.3.14 Создание базы данных в виде файла и их обработка

Для закрепления полученных навыков программирования в среде Турбо Паскаль необходимо составить программу в которой: Реализовать редактирование записей (изменение, добавление, удаление). Исходные данные должны вводиться с проверкой на область допустимых значений. Реализовать в соответствии со своим вариантом запрос: «Определить общее количество товара, поступившего за определенный год» и вывод содержимого записи по определенным ключам. Предусмотреть вывод всей базы данных на экран. Вся обработка базы данных должна происходить путем выбора соответствующего пункта из меню.

Текст программы приведён в Приложении, А в листинге А.14.

Для тестирования программы использовались данные, приведённые в таблице 11. Полученные результаты приведены там же Таблица 11 — Результаты выполнения линейного алгоритма

Результат решения задачи представлен на рисунке 2.17 — 2.24

Рисунок 2.17 -Результат работы программы в Turbo Pascal

Рисунок 2.18 -Результат работы программы в Turbo Pascal

Рисунок 2.19 -Результат работы программы в Turbo Pascal

Рисунок 2.20 -Результат работы программы в Turbo Pascal

Рисунок 2.21 -Результат работы программы в Turbo Pascal

Рисунок 2.22 -Результат работы программы в Turbo Pascal

Рисунок 2.23 -Результат работы программы в Turbo Pascal

2.4 Программирование на языке Object Pascal в среде Delphi

Для закрепления полученных навыков программирования на языке Object Pascal в среде Delphi необходимо решить задачу, вычисляющую сумму, разность и произведение двух заданных элементов.

Даны числа, а и в, вводимые с клавиатуры. Необходимо найти сумму S, разность R, произведение P, частное от деления C по формулам (1) и (2).

Блок-схема алгоритма задачи приведена в Приложении Б на рисунке Б.1.

Текст программы приведён в Приложении, А в листинге А.2.

Для тестирования программы использовались данные, приведённые в таблице 1. Полученные результаты приведены там же.

Внешний вид решаемой задачи представлен на рисунке 2.24.

Рисунок 2.24 — Результат работы программы в Delphi

Заключение

В рамках учебной практики была поставлена задача программной реализации индивидуального задания, вычисляющего сумму, разность и произведение двух заданных элементов.

Данное задание было отлажено и реализовано с использованием среды программирования Turbo Pascal и среды визуального программирования Delphi.

В процессе разработки программы использовался в большом объёме материал по программированию.

Цели по решению задач, поставленные во время прохождения учебной практики, достигнуты. Работа программы проверена на тестовом примере.

1. Багласова Т. Г. Методические указания по оформлению курсовых и дипломных работ. — Мн.: ТБП, 2006

2. Культин Н. Б. Программирование в Turbo Pascal и Delphi. 2-ое изд. переработанное и дополненное. — СПб: БХВ-Петербург, 2008

3. Леонтьев В. П. Новейшая энциклопедия персонального компьютера. — М.: ОЛМА-ПРЕСС, 2002

4. Грибанов В. П. и др. Основы алгоритмизации и программирование. — М.: Бином, 1999

5. Фаронов В. В. Delphi. Программирование на языке высокого уровня. — СПб: Питер, 2005

6. ГОСТ 2.106−96. ЕСКД. Текстовые документы

7. ГОСТ 19.401−2000. ЕСПД. Текст программы

8. ГОСТ 19.701−90. ЕСПД. Схемы алгоритмов, программ, данных и систем

Приложение А

(обязательное)

Текст программы

Листинг А.1 — Программа математических вычислений на языке Pascal

Program serg;

uses crt;

var a, b, c, p, ha, hb, hc: real; {переменные}

s:string;

k:integer;

begin{начало}

clrscr;

repeat

repeat

write ('Введите длину стороны а, положительное число a=');

readln (s);

val (s, a, k);

if (k<>0)or (a<=0) then writeln ('Длина введена неверно, повторите ввод')

until (k=0)and (a>0);

repeat

write ('Введите длину стороны b, положительное число b=');

readln (s);

val (s, b, k);

if (k<>0)or (b<=0) then writeln ('Длина введена неверно, повторите ввод')

until (k=0)and (b>0);

repeat

write ('Введите длину стороны с, положительное число с=');

readln (s);

val (s, c, k);

if (k<>0)or (c<=0) then writeln ('Длина введена неверно, повторите ввод')

until (k=0)and (c>0);

if (a>=b+c)or (b>=a+c)or (c>=a+b) then writeln ('Это не треугольник, повторите ввод')

until (a

p:=(a+b+c)/2;

ha:=2*sqrt (p*(p-a)*(p-b)*(p-c))/a; {формула вычисления стороны треугольника}

hb:=2*sqrt (p*(p-a)*(p-b)*(p-c))/b;

hc:=2*sqrt (p*(p-a)*(p-b)*(p-c))/c;

write ('ha=', ha:0:2,' hb=', hb:0:2,' hc=', hc:0:2);

readln

end. {конец}

Листинг А.2 — Программа вычисления всех сторон треугольника

Program serg;

uses crt;

procedure vvod (var x: real;c:char); {процедура}

var s: string;

k:integer;

begin{начало программы}

repeat

write (`введите длину стороны `, c,' положительное число x=');

readln (s);

val (s, x, k);

if (k<>0)or (x<=0) then writeln ('Длина введена неверно, повторите ввод')

until (k=0)and (x>0);

end;

procedure Vysota (a, b, c, p: real;var h: real);

begin

h:=2*sqrt (p*(p-a)*(p-b)*(p-c))/a; {формула вычисления сторон треугольника}

end;

var a, b, c, p, ha, hb, hc: real;

begin

clrscr;

repeat

vvod (a,'A');

vvod (b,'B');

vvod (c,'C');

if (a>=b+c)or (b>=a+c)or (c>=a+b) then writeln (Это не треугольник, повторите ввод')

{ошибка неверного ввода чисел}

until (a

p:=(a+b+c)/2;

Vysota (a, b, c, p, ha);

Vysota (b, a, c, p, hb);

Vysota (c, a, b, p, hc);

write ('ha=', ha:0:2,' hb=', hb:0:2,' hc=', hc:0:2);

readln

end {конец}

Листинг А.3 — Программа вычисления суммы четных строк массива

Program serg;

Const c = 5;

Type TAr = array[1.c, 1. c] of integer;

function sum (ar: TAr): integer; {функция}

var

i, j, s: integer;

begin

for i := 1 to c div 2 do

for j := 1 to c do

s := s + ar[i * 2, j]; {формула вычисления суммы строк массива}

sum := s;

end;

var

a: TAr;

i, j, S: integer;

begin

randomize;

writeln ('ishodi massiv:');

writeln;

s := 0;

for i := 1 to c do

begin

for j := 1 to c do

begin

a[i, j] := random (101) — 50;

write (a[i, j]: 6);

end;

writeln;

end;

writeln;

S := sum (a);

write ('summa elementiv nechetnih strok = ');

writeln (S);

readln;

end. {конец}

Листинг А.4 - Программа вычисления количества слов в строке

Program serg; {начало}

var

s:string; {переменная строкового типа}

sl:integer; {переменная целого типа}

procedure Zimmer (Dano: string; var Slova: integer);

var i: integer;

begin

slova:=0;

for i:=1 to length (Dano) do

if (Dano[i]=' ')and (Dano[i-1]<>' ') then inc (slova);

inc (slova);

end;

begin

Write ('Введите строку: ');

readln (s); {вводим строку из слов}

Zimmer (s, sl);

Writeln ('Количество слов в строке = ', sl);{выводит количество слов строке}

readln;

end. {конец}

Листинг А.5 - Программа поиска жильцов дома по фамилии или по номеру квартиры

uses crt;

type doc=record

nom:integer;

kol:integer;

tex:string;

age:integer;

end;

var f: file of doc;

z:doc;

n, i, k, np, j: integer;

t:string;

w:char;

procedure Vvod;

begin

clrscr;

assign (f,'docs');

rewrite (f);

writeln ('Количество квартир n=');

readln (n);

for i:=1 to n do

begin

writeln ('квартира: ', i);

write ('-Номер: ');readln (z.nom); {вводим номер квартиры}

write (' - количество:'); readln (z.kol); {вводим кол. Человек}

write (' - Фамилия: ');readln (z.tex); {вводим фамилии}

write (' - Возраст: ');readln (z.age); {вводим возраст}

write (f, z);

end;

close (f);

end;

procedure Vivod;

begin

clrscr;

writeln (`список квартир:');

reset (f);

writeln ('—————————————————————————————————————-');

writeln (' Номер квартиры ':15, ' | ', 'Людей проживает':15, ' | ', 'Фамилия':17, ' | ', 'возраст':10, '| ');

writeln ('—————————————————————————————————————-');

while not eof (f) do

begin

read (f, z);

writeln (z.nom:15, ' | ', z. kol:15, ' | ', z. tex:15, ' | ', z. age:17,' | ');

end;

close (f);

writeln ('—————————————————————————————————————');

write (' жмите Enter ');

readln;

clrscr;

end;

procedure Poisk;

begin

if np=1 then

begin

writeln (введите фамилию для поиска :');

readln (t);

end;

if np=2 then

begin

writeln ('введите номер квартиры:');

readln (j);

end;

reset (f);

k:=0;

writeln ('—————————————————————————————————————');

writeln (' Номер квартиры ':15, ' | ', 'Людей проживает':15, ' | ', 'Фамилия':17, ' | ', 'возраст':10, '| ');

writeln ('—————————————————————————————————————');

while not eof (f) do

begin

read (f, z);

if np=1 then

if z. tex=t then

begin

k:=1;

writeln (z.nom:15, ' | ', z. kol:15, ' | ', z. tex:15, ' | ', z. age:17,' | ');

end;

if np=2 then

if z. nom=j then

begin

k:=1;

writeln (z.nom:15, ' | ', z. kol:15, ' | ', z. tex:15, ' | ', z. age:17,' | ');

end;

end;

close (f);

writeln ('————————————————————————————————————-');

if k=0 then writeln (`Поиск не дал результатов ');

writeln (' жмите Enter');

readln;

clrscr;

end;

begin

Vvod;

Vivod;

repeat

writeln ('выберите критерий для поиска');

writeln ('искать по: фамилии-1, квартире-2');

readln (np);

Poisk;

writeln (`повторить поиск? Y/y-yes, если нет, жмите любую Другую клавишу + Enter');

readln (w); {можем или повторить поиск либо завершить его}

until not (w in ['Y','y']);

end. {конец}

Листинг А.6 - Программа вычисления среднего арифметического и геометрического положительных чисел

Текст программы

Program arifgeom;

uses modul, crt;

var a: mas;

arif, count, geom: integer;

begin

clrscr;

vvod (a);

vyvod (a);

raschet (a, arif, count, geom);

if count>0 then

begin

writeln ('Srednee arifmeticheskoe = ', arif/count:8:4); {вывод сред. Арифм.}

writeln ('Srednee geometricheskoe = ', exp (ln (geom)/count):8:4);{вывод стред. Геометр.}

end

else writeln ('Net polozhitelnych chisel');

readkey

end.

Текст модуля

unit modul;

interface

const n = 6;

type mas=array[1.N] of integer;

Procedure vvod (var a: mas);

Procedure vyvod (a:mas);

Procedure raschet (a:mas;var arif, count, geom: integer);

implementation

Procedure vvod;

var i: integer;

begin

write ('Vvedite ', N, ' chisel cherez probel->'); {вводим числа}

for i:= 1 to N do

read (a[i]);

readln

end;

Procedure vyvod;

var i: integer;

begin

writeln ('Ischodniy massiv:');

for i:= 1 to N do

write (a[i]: 8);

writeln

end;

Procedure raschet;

var i: integer;

begin

geom := 1;

arif := 0;

count := 0;

for i := 1 to n do

if a[i] > 0 then

begin

geom := geom * a[i]; {расчет сред. Геометр.}

arif := arif + a[i]; {расчет сред. Арифм.} Inc (count);

end;

end;

end.

Листинг А.7-Программа вычисления n-го члена по рекуррентной формуле

function f (n:integer):extended;

begin

if n=1 then f:=1

else if n=2 then f:=0.3

else f:=(n+1)*f (n-2)

end;

var n: integer; {переменная целого типа}

begin

repeat

write ('n>2 n=');

readln (n); {вводим число}

until n>2;

write ('x=', f (n):0:1);

readln

end. {конец}

Листинг А.8 — Программа удаления элементов из массива кратных 6.

uses crt;

const nmax=100;

var a: array[1.nmax] of integer;

n, i, j, k: integer; {переменные целого типа}

begin

clrscr;

randomize;

repeat

write ('Razmer massiva до ', nmax,' n=');

readln (n); {вводим n}

until n in [1.nmax];

writeln ('Ishodi massiv:');

for i:=1 to n do

begin

a[i]: =random (50)+1;

write (a[i]:4);

end;

writeln;

i:=1;

k:=0;

while i<=n do

if a[i] mod 6=0 then

begin

k:=1;

if i=n then n:=n-1

else

begin

for j:=i to n-1 do

a[j]: =a[j+1];

n:=n-1

end

end

else i:=i+1;

if k=0 then write ('V massive net elementov, kratnih 6 ')

else if n=0 then write ('Все элементы удалены')

else

begin

writeln ('Udalenie elementov, kratnih 6');

for i:=1 to n do

write (a[i]: 4);

end;

readln

end. {конец}

Листинг А.9 — Программа в которой требуется в заданный массив AX(N) добавить массив C(K),далее выполнить сортировку включением и удалить элементы кратные шести.

uses crt;

procedure sortirovka;

var ax, c: array [1.100] of integer;

a, n, m, i, j, k, p:integer;

begin

clrscr;

randomize;

write ('Введите n=');readln (n); {вводима размер массива n}

write ('Введите k=');readln (k); {вводим размер массива k}

writeln ('€б室­л© ббЁў A:');

for i:=1 to n do

begin

write ('ax[', i,']');

readln (ax[i]); {вводима числа массива n}

end;

writeln;

writeln ('Массив C:');

for i:=1 to k do

begin

write ('c[', i,']');

readln (c[i]); {ввожима числа массива k}

end;

writeln;

for i:=1 to k do

begin

n:=n+1;

ax[n]: =c[i];

end;

writeln ('Объедененный массив:');

for i:=1 to n do

write (ax[i]: 4);

writeln;

for i:=2 to n do

begin

a:=ax[i];

j:=1;

while a>ax[j] do

inc (j);

for m:=i-1 downto j do

ax[m+1]: =ax[m];

ax[j]:=a;

end;

writeln ('Массив после сортировки:');

for i:=1 to n do

write (ax[i]: 4);

writeln;

p:=0;

for i:=1 to n do

begin

if ax[i] mod 6=0 then

begin

for j:=i to n-1 do

ax[j]: = ax[j+1];

n:=n-1;

end;

end;

writeln ('Массив без элементов кратных 6:');

for i:=1 to n do

write (ax[i], ' ');

end;

begin

sortirovka;

readln;

end. {конец}

Листинг А.10 — Программа в которой требуется в заданный массив AX(N) добавить массив C(K),далее выполнить обменную сортировку и удалить элементы кратные шести.

uses crt;

procedure sortirovka;

var ax, c: array [1.100] of integer;

a, n, m, i, j, k, p:integer;

begin

clrscr;

randomize;

write ('Введите n=');readln (n); {вводима размер массива n}

write ('Введите k=');readln (k); {вводим размер массива k}

writeln ('€б室­л© ббЁў A:');

for i:=1 to n do

begin

write ('ax[', i,']');

readln (ax[i]); {вводима числа массива n}

end;

writeln;

writeln ('Массив C:');

for i:=1 to k do

begin

write ('c[', i,']');

readln (c[i]); {ввожима числа массива k}

end;

writeln;

for i:=1 to k do

begin

n:=n+1;

ax[n]: =c[i];

end;

writeln ('Объедененный массив:');

for i:=1 to n do

write (ax[i]: 4);

writeln;

for i:=2 to n do

begin

a:=ax[i];

j:=1;

while a>ax[j] do

inc (j);

for m:=i-1 downto j do

ax[m+1]: =ax[m];

ax[j]:=a;

end;

writeln ('Массив после сортировки:');

for i:=1 to n do

write (ax[i]: 4);

writeln;

p:=0;

for i:=1 to n do

begin

if ax[i] mod 6=0 then

begin

for j:=i to n-1 do

ax[j]: = ax[j+1];

n:=n-1;

end;

end;

writeln ('Массив без элементов кратных 6:');

for i:=1 to n do

write (ax[i], ' ');

end;

begin

sortirovka;

readln;

end. {конец}

Листинг А.11- Программа в которой требуется в заданный массив AX(N) добавить массив C(K),далее выполнить сортировку разделением и найти наименьшее положительное значение.

Uses Crt;

Type mas=array[1.100] of integer;

Var

i, n, k:integer;

AX, C, NM, Q: mas;

procedure quick_sort (n:word; var a: mas); {сортировка разделением}

Procedure Sort1(l, r: word); {процедура сортировки}

var buf, x: integer;

a:mas;n:integer;

i, j: word;

begin

i:=l;j:=r;

x:=a[(l+r) div 2];

repeat

while a[i]

while a[j]>x do j:=j-1;

if i<=j then

begin

buf:=a[i];

a[i]:=a[j];

a[j]:=buf;

i:=i+1;

j:=j-1;

end;

until i>j;

if l

if i

end;

begin

sort1 (1,n);

end;

Procedure nmas (Var NM: mas;a, b: mas;n, k: integer);{процедура создания массива}

var j: integer;

begin

for i:=1 to n do NM[i]: =a[i];

j:=n+1;

for i:=1 to k do

begin

NM[j]: =b[i];

inc (j);

end;

end;

Begin

ClrScr;

Write ('Введите n:'); {вводим размер массива n}

ReadLn (n);

For i:=1 to n do

begin

Write ('AX[', i,']: ');

ReadLn (AX[i]); {вводим значения массива}

end;

Write ('Введите k:'); {вводим размер массива k}

ReadLn (k);

For i:=1 to k do

begin

Write ('C[', i,']: ');

ReadLn (C[i]); {вводим значения массива}

end;

nmas (NM, AX, C, n, k);

k:=n+k; {ищем первый положительный}

writeln (' Объединенный массив'); {выводит объединённый массив}

For i:=1 to k do

Write (NM[i]: 4);

writeln;

For i:=1 to k do

begin

while NM[i] <=0 do i:=i+1;

writeln (' Наименьшее положительное', nm[i]);

write;

readln;

end;

ReadKey;

end. {конец}

Листинг А.12- Программа в которой требуется заполнить массива случайными значениями, присвоить указателю адрес 4-ого элемента, напечатать его значение, используя текущий базовый адрес сегмента и смещение с преобразованием в значение типа указатель, а так же заменить его содержимое на значения 7-ого элемента, увеличенное в два раза.

uses crt;

var

y: array [1.100] of real;

p: ^real;

i: integer;

procedure sort;

begin

for i:=1 to 14 do if (i mod 3) = 0 then write (i:2,' element=', y[i]: 4:2);

WriteLn;

writeln (' ¤аҐб 4-®Ј® н"ҐҐ­в ');

p:=@y[4]; {адрес 4-ого элемента}

WriteLn (Seg (p^),':', Ofs (p^)); {значение указателя}

writeln (' ‡ Ґ­Ёвм 4-© н"ҐҐ­в §­ 祭ЁҐ 7-®Ј® н"ҐҐ­в Ё 㢥"ЁзЁвм ў ¤ў а § ');

p^:=y[7]*2;

WriteLn ('­®ў®Ґ §­ 祭ЁҐ: ', p^:4:2);{вывести новое значение}

end;

begin

clrscr;

Randomize;

writeln ('б"гз (c)­лҐ §­ 祭Ёпя:');

for i:=1 to 14 do

begin

y[i]: =Random*100; {заполнение случайными значениями}

Writeln (y[i]: 8:1); {вывод на экран}

end;

WriteLn;

writeln (' ¤аҐб ­ з «а §ҐйҐ­Ёп ббЁў ў Ї пвЁ');

p:=@y; {адрес начала размещения массива в памяти}

sort;

readln;

end. {конец}

Листинг А.13 -Программа работы со списками

Program jyrnalka;

Uses Crt;

Type

NameStr = String [20];

Link = ^Jyrnal;

Jyrnal = record

Name: NameStr;

index: String;

Next: Link;

Cen:real;

end;

Var P, First: Link;

NamFind: NameStr;

V: 0.4;

EndMenu: boolean;

Function FindName (FN:NameStr): Link;

Var Curr: Link;

begin

Curr:=First;

while Curr <> Nil do

if Curr^.Name=FN then

begin

FindName:=Curr;

Exit;

end

else Curr:=Curr^.Next;

FindName:=Nil;

end;

procedure AddFirst (A:Link);

begin

A^. Next:=First;

First:=A;

end;

procedure DelFirst (var A: Link);

begin

A:=First;

First:=First^. Next;

end;

procedure DelAfter (Old:Link; var A: Link);

begin

A:=Old^.Next;

Old^.Next:=Old^.Next^.Next;

end;

procedure jyrn;

begin

P:=New (Link);

Writeln ('Vvedite naimenovanie: ');

Readln (P^.Name) ;

Writeln ('Vvedite index: ');

Readln (P^.index);

writeln ('Vvedite ceny: ');

readln (P^.Cen);

AddFirst (P);

end;

procedure MyList;

var Curr: Link;

begin

Curr:=First;

while Curr <> Nil do

begin

Writeln ('Naimenovanie: ', Curr^. Name);

writeln ('Index: ', Curr^. index) ;

writeln ('Cena: ', Curr^. cen:0:0);

Curr:=Curr^.Next;

end ;

Write ('Vivod spiska okonchen. Najmite Enter');

Readln;

end;

Begin

New (P);

EndMenu:=False ;

repeat

ClrScr;

Writeln ('Ykajite vid raboti: ');

Writeln ('1. Zapis v pervii spisok');

Writeln ('2. Ydalenie pervogo obkta iz spiska');

WriteLn ('3. Prosmotr vsego spiska') ;

Writeln ('4.Ydalenie obekta ') ;

WriteLn ('0. Okonchanie raboti');

Readln (V) ;

Case V of

1: jyrn;

2: DelFirst (P);

3: MyList;

4: begin

Write ('Vvedite naimenovanie zapisi sledyushego za ykazannim :');

Readln (NamFind) ;

DelAfter (FindName (NamFind), P);

FindName (NamFind)

end

else EndMenu:=True;

end;

until EndMenu;

Dispose (p);

readln;

end.

Листинг А.14 — Программа построения базы данных на языке Turbo Pascal.

{$A+, B-, D+, E+, F-, G-, I+, L+, N+, O-, P-, Q-, R-, S+, T-, V+, X+}

{$M 16 384,0,655 360}

program db; {основной код программы}

Uses Crt, Dos, Input, File_Rec;

Const

LenNaimt=27; {Максимальная длина наименования товара}

BasaTmp='basa.tmp'; {Имя рабочего (временного) файла записей}

Enter='Нажмите ENTER…';

Empty='';

EmptyFile=' Файл записей пуст. ';

NoFile='Файл записей не существует!!! ';

Continue='Для окончания операции введите ESC, для продолжения — Enter';

CaseStr='Выберите курсором нужный режим. ';

Konec='Работа с базой данных закончена. ';

RecNotFound='Запись НЕ найдена!!! ';

Shure='Вы уверены, что это нужная запись? (Y/N)';

Inv1='Ввод базы данных';

Inv2='Вывести данные на экран';

Inv3='Вычислить общее количество товаров за определенный год';

Inv4='Вывести содержимое записи по ключу';

Inv5='Добавить запись';

Inv6='Изменить запись';

Inv7='Удалить запись';

FileL =12; {Максимальная длина файла в MS DOS}

YearMin=1990; {Минимальный год}

YearMax=2014; {Максимальный год}

Type

data = record

day: byte;

year: word;

month: byte; end;

RecType=record

naimt: string[LenNaimt];

kolt: longint;

stoimt: real;

dmg: data; end;

file1=file of RecType;

Var mas: RecType;

ch: char;

flag: boolean;

MaxElem: word; {Ограничение максимального количества записей}

ff, ff1: file1;

FileName: string[FileL];

Procedure TopT;

begin

writeln (' —————————————————————————————————-');

writeln ('| Наименование | Кол-во | Стоимость| Год |Месяц|День|');

writeln (' —————————————————————————————————-');

end;

{Процедура вывода нижней части шапки таблицы}

Procedure EndT;

begin

writeln (' —————————————————————————————————-');

end;

{Процедура ввода значений элементов полей записи}

Procedure InputFields (var rec: RecType);

Var a: real;

s: String;

begin

InputString (S, LenNaimt, 'Наименование'); Rec. naimt:=s;

InputNumber (a, 0,2 147 483 647,10,'Количество'); Rec. kolt:=trunc (a);

InputReal (a, 11,'Стоимость'); rec. stoimt:=a;

InputNumber (a, YearMin, YearMax, 4,'Год'); rec.dmg.year:=trunc (a);

InputNumber (a, 1,12,2,'Месяц'); rec.dmg.month:=trunc (a);

InputNumber (a, 1,31,2,'День'); rec.dmg.day:=trunc (a);

end;

{Процедура вывода значений элементов полей записи}

Procedure OutputRec (rec: RecType);

begin

Write ('|', Rec. naimt); Gotoxy (29,Wherey);

Write ('|', Rec. kolt:10); Gotoxy (40,Wherey);

Write ('|', Rec. stoimt:11:2); Gotoxy (52,Wherey);

Write ('|', Rec.dmg.year:5); Gotoxy (58,Wherey);

Write ('|', Rec.dmg.month:3); Gotoxy (64,Wherey);

Write ('|', Rec.dmg.day:3); Gotoxy (69,Wherey);

Writeln ('|');

end;

{Создание файла записей}

Procedure InputRecord (var MaxElem: word);

Var i: Word;

ch: Char;

mas: RecType;

begin

i:=0;

assign (ff, BasaTmp); {Открыть временный файл на запись}

rewrite (ff);

repeat

clrscr;

inc (i);

InputFields (mas);

write (ff, mas);

OutMessageXY (12,23,Continue, Empty);

ch:=Readkey;

until ch=#27;

close (ff);

MaxElem:=i;

end;

{Вывод записей из временного файла записей}

Procedure OutRecord (Var MaxElem: word);

Var i: Word;

mas: RecType;

begin

clrscr;

if Pust (BasaTmp, False) then

begin

assign (ff1,BasaTmp); {Открыть временный файл на чтение}

reset (ff1);

TopT;

i:=0;

While not Eof (ff1) do

begin

seek (ff1,i);

read (ff1,mas);

OutputRec (mas);

i:=i+1;

end;

EndT;

OutMessageXY (20,24,Empty, Enter);

MaxElem:=i;

close (ff1);

end

else OutMessageXY (20,24,NoFile, Enter);

readln;

end;

Procedure Zapros1;

Var a, Sum: Real;

god, i: Word;

mas: RecType;

begin

Clrscr;

if Pust (BasaTmp, False) or (MaxElem<>0) then

begin

Writeln ('Вычислить общее количество товаров за определенный год');

InputNumber (a, YearMin, YearMax, 4,'Год');

god:=trunc (a);

sum:=0;

TopT;

assign (ff, BasaTmp); {Открыть временный файл на чтение}

reset (ff);

i:=1;

while not Eof (ff) do

begin

seek (ff, i-1);

read (ff, mas);

if mas.dmg.year=god then

begin

sum:=sum + mas. kolt;

OutputRec (mas);

end;

i:=i+1;

end;

EndT;

Writeln;

if sum<>0 then

begin

Writeln (

'Cуммарное количество товара за ', god,' год составляет', sum:12:0);

OutMessageXY (20,24,Empty, Enter);

end

else OutMessageXY (10,24,RecNotFound, Enter);

end

else OutMessageXY (20,24,NoFile, Enter);

readln;

end;

Procedure KeyRec;

var ch: char;

r, st: Real;

f, f1: Boolean;

Num, J, god: Word;

Str: String;

mas: RecType;

Label 1;

begin

repeat

f:=true;

clrscr;

if not Pust (BasaTmp, False) or (MaxElem=0) then

begin

OutMessageXY (20,24,NoFile, Enter);

Readln;

Exit;

end;

writeln ('Вывести содержимое записи по ключу');

writeln ('1: номер записи');

writeln ('2: наименование товара');

writeln ('3: стоимость товара');

writeln ('4: год поступления товара');

Writeln;

Writeln ('Введите нужный ключ');

ch:=Readkey;

case ch of

'1': begin

InputNumber (r, 1, MaxElem, 2,' Введите номер записи');

Num:=trunc®;

end;

'2': InputString (Str, LenNaimt,' Введите наименование товара');

'3': InputReal (st, 11,' Введите стоимость товара');

'4': begin

InputNumber (r, YearMin, YearMax, 4,' Введите год поступления товара');

god:=trunc®;

end

else

begin

Clrscr;

Writeln ('Неизвестное значение ключа');

OutMessageXY (20,24,Empty, Enter);

readln;

f:=false;

end;

end;

until f;

f:=false; {Логический признак нормального завершения работы}

f1:=false; {Логический признак выдачи нужной записи}

ClrScr;

TopT;

assign (ff, BasaTmp); {Открыть временный файл на чтение}

reset (ff);

if ch='1' then

begin

seek (ff, num-1);

read (ff, mas);

OutputRec (mas);

f:=true;

goto 1;

end;

for j:=1 to MaxElem do

begin

seek (ff, j-1);

read (ff, mas);

case ch of

'2': if str=mas.naimt then

begin

f:=true;

f1:=true;

end;

'3': if st=mas.stoimt then

begin

f:=true;

f1:=true;

end;

'4': if god=mas.dmg.year then

begin

f:=true;

f1:=true;

end;

end;

if f1 then

begin

OutputRec (mas);

f1:=false

end

end;

1:

if f then

begin

EndT;

OutMessageXY (20,24,Empty, Enter);

end

else OutMessageXY (10,24,RecNotFound, Enter);

Readln;

close (ff);

end;

{Процедура изменения (Flag=True) или удаления (Flag=False) записи из файла записей}

Procedure ChangeDel (flag: boolean);

Var ch: char;

i, j: Word;

mas: RecType;

begin

if not Pust (BasaTmp, False) then

begin

OutMessageXY (10,24,EmptyFile, Enter);

Readln;

Exit

end;

repeat

clrscr;

if flag then writeln ('Введите номер изменяемой записи [1.', MaxElem,']===>')

else writeln ('Введите номер удаляемой записи [1.', MaxElem,']===>');

{$I-}

Readln (i);

{$I+}

until (IOResult=0)and (i>0) and (i<=MaxElem);

TopT;

assign (ff, BasaTmp); {Открыть временный файл}

reset (ff);

seek (ff, i-1);

read (ff, mas);

OutputRec (mas);

EndT;

writeln;

OutMessageXY (20,24,Shure, Empty);

ch:=ReadKey;

if (ch='y')or (ch='Y')then

begin

if flag then

begin

InputFields (mas) {Ввод всех полей заново для изменяемой записи i};

seek (ff, i-1);

write (ff, mas);

end

else {удаление записи i}

begin

for j:=i to MaxElem-1 do

begin

seek (ff, j); { Аналог mas[j]: =mas[j+1];}

read (ff, mas);

seek (ff, j-1);

write (ff, mas);

end;

MaxElem:=MaxElem-1;

truncate (ff); {усечение файла ff}

end;

if not flag then OutMessageXY (20,24,'Запись удалена. ', Enter)

else OutMessageXY (20,24,'Запись изменена. ', Enter);

readln;

close (ff);

end

end;

{Процедура добавления записи в файл записей}

Procedure AddRecord;

Label 1;

Var i, j: Word;

mas: RecType;

begin

repeat

clrscr;

Writeln ('Введите номер добавляемой записи [1.', MaxElem+1,']===>');

{$I-}

readln (i);

{$I+}

until (IOResult=0)and (i>0) and (i<=MaxElem+1);

MaxElem:=MaxElem+1;

1:

assign (ff, BasaTmp); {Открыть временный файл}

{$I-}

reset (ff);

{$I+}

if IOResult<>0 then {Если файл BasaTmp еще НЕ существует}

begin

Rewrite (ff); {Создаем временный файл BasaTmp}

Close (ff);

goto 1; {повторяем еще раз, — файл BasaTmp уже существует}

end;

for j:=MaxElem downto i+1 do {перепись всех элементов от i+1 до MaxElem}

begin

seek (ff, j-2); { Аналог mas[j]: =mas[j-1];}

read (ff, mas);

seek (ff, j-1);

write (ff, mas);

end;

InputFields (mas); {Ввод добавляемой записи}

seek (ff, i-1);

write (ff, mas);

OutMessageXY (20,24,'Запись добавлена. ', Enter);

readln;

close (ff);

end;

{Процедура коррекции положения курсора при движении стрелки вверх-вниз}

Procedure UpDown (var Vari: integer; Im: byte);

begin

if ch=#0 then ch:=readkey;

case ch of

#72: begin {стрелка вверх}

if vari=1 then vari:=im else vari:=vari-1;

gotoxy (1,vari);

end;

#80: begin {стрелка вниз}

if vari=im then vari:=1 else vari:=vari+1;

gotoxy (1,vari);

end;

end;

end;

{Процедура создания базы данных}

Procedure CreateDB (Var MaxElem: word);

var i, j: word;

Str: String;

mas: RecType;

begin

Clrscr;

writeln ('1- Использовать существующий файл базы данных');

writeln ('2- Создать новый файл базы данных с клавиатуры ');

OutMessageXY (25,24,'Введите нужный ключ. ', Empty);

repeat

{$I-}

readln (i);

{$I+}

until (IoResult=0) and ((i=1) or (i=2));

case i of

1: begin

Clrscr;

DirCat;

Repeat

InputString (Str, FileL,' Введите имя файла базы данных');

FileName:=Str;

until Pust (FileName, True);

assign (ff1, BasaTmp); {Открыть временный файл на запись}

rewrite (ff1);

assign (ff, FileName); {Открыть файл FileName на чтение}

reset (ff);

j:=0;

While not eof (ff) do

begin

j:=j+1;

read (ff, mas);

write (ff1,mas);

end;

MaxElem:=j;

close (ff);

close (ff1);

end;

2: InputRecord (MaxElem);

end;

end;

{Функция организации главного меню}

Function MainMenu: boolean;

const i: integer=1; {начальное положение курсора}

var k: char;

name: string;

j: word;

begin

MainMenu:=false;

clrscr;

Writeln (Inv1);

Writeln (Inv2);

Writeln (Inv3);

Writeln (Inv4);

Writeln (Inv5);

Writeln (Inv6);

Writeln (Inv7);

Writeln ('Выход');

OutMessageXY (15,24,CaseStr, Enter);

Gotoxy (1,i);

repeat

ch:=readkey;

if (ch=#32) or (ch=#13)then

begin

case i of

1: CreateDB (MaxElem); {Создать базу данных}

2: OutRecord (MaxElem); {Вывести данные на экран}

3: Zapros1; {Вычислить общее количество товаров за определенный год}

4: KeyRec; {Вывести содержимое записи по ключу}

5: AddRecord; {Добавить запись}

6: ChangeDel (true); {Изменить запись}

7: ChangeDel (false); {Удалить запись}

8: Begin {Выход}

Mainmenu:=true;

Clrscr;

if MaxElem<>0 then

Begin

Assign (ff1,BasaTmp); {Открыть временный файл на чтение}

Reset (ff1);

Writeln ('Сохранить базу данных? (Y/N)');

k:=ReadKey;

If (k='y') or (k='Y') then

begin

ClrScr;

DirCat;

InputString (Name, FileL, 'Введите имя файла для сохранения базы данных');

Assign (ff, name);

Rewrite (ff);

For j:=1 to MaxElem do

Begin

Read (ff1,mas);

Write (ff, mas);

End;

Close (ff);

OutMessageXY (20,24,Konec, Enter);

readln;

end;

Close (ff1);

Erase (ff1); {Удаление временного файла}

End; { if MaxElem<>0}

Exit;

End; {Выход}

end; { case }

exit;

end { if (ch=#32) or (ch=#13)}

else UpDown (i, 8);

until false;

end;

{Главная программа}

begin

clrscr;

MaxElem:=0;

repeat until MainMenu;

end.

Unit Input; {подключение модуля Input}

Interface {Интерфейсная часть — заголовки процедур и функций}

{ Преобразование любого целочисленного типа в string }

Function IntToStr (I: Longint): String;

{Вывод сообщений Str1, Str2, начиная с позиции курсора X, Y}

Procedure OutMessageXY (X, Y: Byte;Str1,Str2:String);

{Вывод Width пробелов цветом Color на фоне Fon с восстановлением прежних атрибутов вывода TaOld и возвратом в начальную позицию курсора}