Разработка программного обеспечения видеотеки

Размещено на http://www.allbest.ru/

БЕЛОРУССКИЙ ГОСУДАРСТВЕННЫЙ УНИВЕРСИТЕТ

ИНФОРМАТИКИ И РАДИОЭЛЕКТРОНИКИ

Кафедра программного обеспечения информационных технологий

Курсовая работа

по дисциплине «Основы алгоритмизации и программирования»

тема: «Видеотека»

Выполнил студент: Стасько В. С.

Минск 2009

Содержание

1. Постановка задачи

2. Входные данные

3. Способ решения

3.1 Процедура добавления

3.2 Процедура удаления

3.3 Процедура поиска

4. Системные требования

5. Структура программы

6. Тестирование программы

7. Методика работы с программой

8. Листинг программы

Литература

1. Постановка задачи

Дана база данных с информацией о фильмах. Разработать программное средство для управления этой базой.

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

В программе должны присутствовать следующие процедуры:

1.Формирование динамического списка;

2.Вывод списка на экран;

3.Добавление элемента в список;

4.Удаление элемента из списка;

5.Поиск элемента списка по соответствующему полю;

6.Запись в файл и загрузка из файла.

7. Сортировка элементов списка.

Выбор необходимого действия обеспечить через удобный интерфейс.

Для записи и загрузки из файла использовать типизированный файл.

2. Входные и выходные данные

Входными данными является запись содержащая информацию о фильме. Запись имеет поля: “Название фильма” тип String[25] , “Жанр фильма” тип String[10], “Актёры” тип String[50], “Краткое описание фильма ” тип String[255].

В ходе выполнения программы формируется упорядоченный динамический список записей.

Программа позволяет выводить список на экран, а так же создавать типизированный файл “DATA.FLM” содержащий список записей.

3. Способ решения

При построении алгоритма программы, для хранения информации о фильме используется запись с четырьмя полями (Subject: string[25]; Genre: string[10]; Actor: string[50]; Subject2: string[255] ) , а так же имеется две записи (UpPointer, DownPointer : PointerSubjs ) содержащее ссылку на предыдущее и следующее звено списка.

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

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

Программа состоит из основных процедур: добавления, удаление, поиск.

3.1 Процедура добавления

Алгоритм добавления элемента в указанное место двунаправленного списка заключается в следующем.

Порождается новое звено и заполняется информационное поле. Полям UpPointer и DownPointer присваивается null. Проверяется, если список пуст то новые становится первым звеном списка. В противном случае новое звено добавляется в список через процедуру вставки.

В ходе процедуры вставки происходит перебор элементов списка до тех пор пока значение поля Subject (название фильма) элемента списка меньше значения поля Subject нового элемента. Далее соответственно произойдет вставка нового звена в начало, в конец, или в середину списка.

При этом в поле DownPointer порожденного звена заносится ссылка на следующий элемент из звена, предшествующего вставляемому.

В поле UpPointer порожденного звена заносится ссылка на предыдущий элемент из звена, следующего за вставляемым.

В поле UpPointer следующего за вставляемым звена заносится ссылка на вставляемое звено.

В поле DownPointer предшествующего звена заносится ссылка на вставляемое звено.

Процедура Add. Добавление элемента в список.

procedure Add(SubjList: PointerSubjs); {процедура добавления элемента в список}

var PSubj, marker: PointerSubjs;

begin

WriteTitle(1,'Add film'); {выводим заголовок}

new (PSubj); {отводим память под новую динамическую переменную}

WriteForm(1,2,PSubj); {выводим и заполняем форму}

PSubj^.UpPointer := nil;

PSubj^.DownPointer := nil;

if SubjList=nil then SubjList := PSubj {присваиваем значение первому звену}

else

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

begin

marker := SubjList;

while (marker^.Subject<Subj^.Subject)AND(marker^.DownPointer<>nil) do

marker := marker^.DownPointer;

if (marker^.UpPointer=nil) AND (marker^.Subject>Subj^.Subject)

then

begin

Subj^.DownPointer := marker;

marker^.UpPointer := Subj;

SubjList:=Subj;

end

else

if (marker^.DownPointer=nil) AND (marker^.Subject<Subj^.Subject)

then

begin

Subj^.UpPointer := marker;

marker^.DownPointer := Subj;

end

else

{в остальных случаях добавляем элемент в середину списка перед текущим звеном}

begin

Subj^.DownPointer := marker;

Subj^.UpPointer := marker^.UpPointer;

marker^.UpPointer := Subj;

marker := Subj^.UpPointer;

marker^.DownPointer := Subj;

end;

end;

WriteTitle(16, 'Film was added');

ReadKey;

end;

3.2 Процедура удаления

программный двунаправленный сортировка алгоритм

Если удаляемый элемент находится в середине списка, тогда выполняется следующий алгоритм.

В поле DownPointer следующего за удаляемым звена заносится ссылка на предшествующее удаляемому звено.

В поле UpPointer предшествующего удаляемому звена заносится ссылка на следующее за удаляемым звено.

Уничтожается удаляемое звено.

Если удаляемый элемент находится в начале списка, тогда в поле DownPointer следующего за удаляемым звена заносится Null и уничтожается удаляемое звено.

Если удаляемый элемент находится в конце списка, тогда в поле UpPointer предшествующего удаляемому звена заносится Null и так же уничтожается удаляемое звено.

Процедура RemoveSubj. удаление элемента из списка.

procedure RemoveSubj(marker:PointerSubjs);

{процедура удаления элемента}

var tmp:PointerSubjs;

begin

if(marker <> NIL) then

begin

{если элемент единственный}

if (marker^.UpPointer = nil) and (marker^.DownPointer = nil) then

begin

SubjList:=nil;

Dispose(marker);

end

else

if (marker^.UpPointer = NIL) then {удаление, если текущее звено первое}

begin

SubjList := marker^.DownPointer;

SubjList^.UpPointer := NIL;

Dispose(marker);

end

else

if (marker^.DownPointer = NIL) then {удаление, если текущее звено последнее}

begin

tmp := marker;

marker := marker^.UpPointer;

marker^.DownPointer := NIL;

Dispose(tmp);

end

else {удаление в остальных случаях, когда звено в середине списка}

begin

tmp := marker;

marker := marker^.UpPointer;

marker^.DownPointer := tmp^.DownPointer;

marker := marker^.DownPointer;

marker^.UpPointer := tmp^.UpPointer;

Dispose(tmp);

end;

end;

end;

3.3 Процедура поиска

Для сравнения элементов поиска в программе имеется функция myFilter(marker:PointerSubjs):boolean. В качестве аргумента функции используется ссылка на элемент списка. Данная функция обеспечивает сравнение элемента списка и искомого элемента.

Если данный элемент удовлетворяет условию поиска, то функция возвращает значение true, иначе false.

Заполняется форма поиска, и данные поиска заносятся в переменную myFilterInfo. Далее выполняется процедура вывода элементов списка на экран. При этом значение фильтра filtering равно true что обеспечивает фильтрацию элементов. Последовательно перебираются все звенья списка и вызывается функция myFilter. Элемент выводится на экран в том случае если все значения полей элемента соответствуют значениям полей переменной myFilterInfo.

Процедура Search. процедура поиска элемента.

procedure Search; {процедура поиска}

var marker:PointerSubjs;

key:char;

begin

fltr:=true;

WriteTitle(1,'Find film'); {выводим заголовок}

marker := SubjList;

filtering := true; {включаем фильтрацию}

setFilter := myFilter; {устанавливаем функциональную переменную в нужный фильтр}

WriteForm(2,3,@myFilterInfo); {заполняем поля, необходимые для фильтрации}

ShowList(15,'List of Found Films', marker,key); {вывод соответствующего списка}

fltr:=false;

end;

Функция myFilter . Функция фильтрации элементов.

function myFilter(marker:PointerSubjs):boolean;

{функция фильтрации}

begin

myFilter := true;

with marker^ do

begin

{проверяем введен ли элемент записи в соответствующее поле и равен ли он полю текущего элемента списка}

if (length(myFilterInfo.Subject) <> 0) AND (Pos (myFilterInfo.Subject, Subject)=0) then

myFilter := FALSE;

if (length(myFilterInfo.Genre) <> 0) AND (Pos (myFilterInfo.Genre, Genre)=0) then

myFilter := FALSE;

if (length(myFilterInfo.Actor) <> 0) AND (Pos (myFilterInfo.Actor, Actor)=0) then

myFilter := FALSE;

end;

end;

4. Системные требования

Системные требования программы минимальные. Необходима возможность работы в режиме MSDOS и поддержка графического режима с расширением 640 x 480.

5. Структура программы

1. Блок-схема процедуры удаления фильма:

Размещено на http://www.allbest.ru/

Размещено на http://www.allbest.ru/

Общая блок-схема программы

Начало программы.

Блок I. Установка начальных значений.

Блок II. Инициализация экрана.

Блок III. Инициализация графического режима.

Блок IV. Определения обработки нажатой клавиши.

Выход из программы.

6. Тестирование программы

Тест 1.

Исходные данные:

Для введения исходных данных используется процедура поиска и заполняется пять форм с информацией о фильмах.

The film name : Platina

Film genre : Detektiv

Actors : Sergey Mahovicov, Ulia Zhigalina

The film description : Film ...

The film name : Dostuchatsy do nebe

Film genre : Detektiv

Actors : Nikolay Osipov

The film description : Film ...

The film name : Igra

Film genre : Komedia

Actors : Sergey Mahovicov

The film description : Film ...

The film name : Pianist

Film genre : Drama

Actors : Mihoil Samoxvalov

The film description : Film ...

The film name : Nebesa

Film genre : Detektiv

Actors : Vladimir Gorushin, Sergey Mahovicov

The film description : Film ...

Результат:

При выполнении процедуры вывода списка на экране отобразился следующий список фильмов:

Dostuchatsy do nebes

Igra

Nebesa

Pianist

Platina

Тест 2.

Исходные данные:

В качестве исходных данных заполняется следующая форма для поиска:

1.

The film name :

Film genre : Detektiv

Actors :

Результат поиска:

Dostuchatsy do nebes

Nebesa

Platina

2.

The film name :

Film genre : Detektiv

Actors : Sergey Mahovicov

Результат поиска:

Nebesa

Platina

3.

The film name :

Film genre :

Actors : Sergey Mahovicov

Результат поиска:

Igra

Nebesa

Platina

Тест 3.

При выполнении процедуры сохранения, в файл в каталоге с данной программой создался типизованный файл “DATA.FLM” содержащий базу с информацией о фильмах. Далее при новом запуске программы и выполнении, сначала процедуры загрузки из файла, а затем процедуры вывода списка элементов, на экране отобразился следующий список.

Dostuchatsy do nebes

Igra

Nebesa

Pianist

Platina

7. Методика работы с программой

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

Для добавления фильма в базу необходимо нажать клавишу 1 “Add film” (добавить фильм).

При этом на экране появится форма для введения информации о фильме Рисунок 1.

В ней имеются поля:

1. The film name - название фильма.

2. Film genre - жанр фильма.

3. Actors - актёры.

4. The film description - описание фильма.

Для вывода списка фильмов на экран используется клавиша 4 “All films” (Все фильмы).

На экран компьютера выводится список упорядоченный в алфавитном порядке рисунок 2.Для просмотра информации о фильме используется клавиша Enter рисунок 3.Для выбора фильма из списка используются клавиши Вверх, Вниз на клавиатуре.

Клавиша 2 “Remove film” (удалить фильм) необходима для удаления фильма.При этом нeнужно выбрать фильм из списка Рисунок 2 и нажать клавишу Enter.

Для поиска используется клавиша 3 “Find film” (найти фильм) и заполняется форма поиска состоящая из трёх полей:

1. The film name - название фильма.

2. Film genre - жанр фильма.

3. Actors - актёры.

Для сохранения списка в файл и загрузки из файла используются соответственно клавиши F2 “Save” и F3 “Load”.

Для выхода из программы используется комбинация клавиш Alt+X.

Рисунок 1

Рисунок 2

Рисунок 3

8. Листинг программы

Program vidioteka;

{программа преднозначеная для управления базой данных с информацией о фильмах.}

{программа позволяет добавлять элементы в список, удалять их, выводить список на экран,}

{искать элементы, записывать в файл и загружать из файла}

uses crt; {подключение стандартного модуля для работы с экраном}

type PointerSubjs = ^Subjs; {тип указатель на запись}

Subjs = record {запись}

Subject: string[15]; {название фильма}

Genre: string[10]; {Жанр}

Actor: string[30]; {актеры}

Subject2: string[255]; {краткое содержание фильма}

UpPointer,DownPointer : PointerSubjs; {указатели на предыдущий и следующий элементы списка}

end;

filterFunction = function(marker:PointerSubjs):boolean;{функциональный тип}

Var i, j, k, h, N: integer;

SubjList, marker: PointerSubjs;

filtering,fltr:boolean; {логическая переменная, указывающая на применение фильтра}

setFilter:filterFunction; {функциональная переменная}

myFilterInfo: Subjs; {переменная для хранения искомых данных}

procedure WriteTitle(i:integer;text:string); {процедура вывода заголовка}

begin

GotoXY(1,i); {помещаем курсор в начало строки вывода}

GotoXY(39-round(Length(text)/2),i); {распологаем курсор так, чтобы текст выводился посередине}

Write(text); {выводим текст заголовка}

end;

procedure WriteForm(x,y:integer;Subj:PointerSubjs); {процедура вывода формы}

var

form:PointerSubjs;

begin

form:=Subj;

x := x;

GotoXY(x,y);

Write('The film name:');

ReadLN(form^.Subject);

Writeln;

Write('Film genre :');

ReadLN(form^.Genre);

Writeln;

Write('Actors :');

ReadLN(form^.Actor);

Writeln;

if not(filtering) then

begin

Write('The film description :');

ReadLN(form^.Subject2);

end;

Inc(y);

end;

procedure WriteSubj(var x:integer; marker:PointerSubjs);

{процедура ввода нового элемента}

begin

if x=1 then

begin

Window(6,7,79,8);

TextBackground(9);

TextColor(14);

ClrScr;

with marker^ do

begin

Write(Subject);

end;

Window(6,8,79,49);

TextBackground(15); {задаем цвет экрана: 7 - светлосерый}

TextColor(0);

x:=0;

end

else

with marker^ do

begin

GotoXY(1,x);

Write(Subject);

end;

end;

{$F+} {включаем компиляцию в режиме дальнего вызова}

function myFilter(marker:PointerSubjs):boolean;

{функция фильтрации}

begin

myFilter := true;

with marker^ do

begin

{проверяем введен ли элемент записи в соответствующее поле и равен ли он полю текущего элемента списка}

if (length(myFilterInfo.Subject) <> 0) AND (Pos (myFilterInfo.Subject, Subject)=0) then

myFilter := FALSE;

if (length(myFilterInfo.Genre) <> 0) AND (Pos (myFilterInfo.Genre, Genre)=0) then

myFilter := FALSE;

if (length(myFilterInfo.Actor) <> 0) AND (Pos (myFilterInfo.Actor, Actor)=0) then

myFilter := FALSE;

end;

end;

{$F-} {выключаем компиляцию в режиме дальнего вызова}

procedure Prev(var marker:PointerSubjs);

{процедура перехода на предыдущий элемент}

var tmp:PointerSubjs;

begin

tmp:=marker^.UpPointer;

if (filtering) then {если фильтрация включена}

begin

{пока не дойдём до начала списка, ищем первый соответствующий элемент}

while (NOT setFilter(tmp)) AND (tmp <> NIL) do

tmp := tmp^.UpPointer;

end;

{если предыдущий элемент определен, то делаем его текущим}

if ( tmp <> NIL ) then marker:=tmp;

end;

procedure Next(var marker:PointerSubjs);

{процедура перехода на следующий элемент}

var tmp:PointerSubjs;

begin

tmp:=marker^.DownPointer;

if (filtering) then {если фильтрация включена}

begin

{пока не дойдём до конца списка, ищем первый соответствующий элемент}

while (NOT setFilter(tmp)) AND (tmp <> NIL) do

tmp := tmp^.DownPointer;

end;

{если следующий элемент определен, то делаем его текущим}

if ( tmp <> NIL ) then marker:=tmp;

end;

procedure SimpleList(var marker:PointerSubjs;

{процедура вывода элементов списка}

i:integer;

count:integer;{количество выводимых элементов}

filter:filterFunction);{функция проверки соответствия элемента}

var current:PointerSubjs;

begin

current := NIL;

while (marker<>NIL) AND (i <= (4*count) ) do

{пока не конец списка или пока не выведено нужное количество элементов}

begin

if (filtering) then {если нужно выбирать особенный элемент}

begin

if filter(marker) then {если элемент соответствует условию}

begin

WriteSubj(i,marker); {выводим элемент}

Inc(i,2);

if ( current = NIL ) then current := marker; {запоминаем первый элемент вывода}

end;

end

else {если фильтрация не используется}

begin

WriteSubj(i,marker); {выводим элемент}

Inc(i,2);

if ( current = NIL ) then current := marker; {запоминаем первый элемент вывода}

end;

marker:=marker^.DownPointer; {переходим к следующему элементу списка}

end;

marker := current; {возвращаем значение первого выведенного элемента}

end;

procedure ShowFilm(marker:PointerSubjs);

{процедура вывода описания фильма}

var i:longint; key:char; done,spec:boolean;

begin

ClrScr;

Window(6,7,79,29);

TextBackground(14);

TextColor(3);

ClrScr;

Writeln;

Writeln;

Writeln('Film genre :');

Writeln;

Writeln('Actors :');

Writeln;

Writeln('The film description :');

TextColor(4);

with marker^ do

begin

GotoXY(20,1);

Write(Subject);

GotoXY(24,3);

Write(Genre);

GotoXY(24,5);

Write(Actor);

GotoXY(24,7);

Write(Subject2);

end;

ReadKey;

Window(6,7,79,49); {область вывода текста}

TextBackground(15); {задаем цвет экрана: 15 - светлосерый}

TextColor(0); {задаем цвет текста: 0 - чёрный}

ClrScr;

end;

procedure ShowList(count:integer; title:string; var marker:PointerSubjs; var code:char);

{процедура вывода элемента}

var i:longint; key:char; done,spec:boolean;

begin

repeat

begin

ClrScr; {очищаем экран перед выводом}

i:=1;

WriteTitle(i,title); {выводим заголовок}

SimpleList(marker, i, count, setFilter); {выводим элементы списка}

done := false; {параметр для определения окончания процедуры}

spec := false; {параметр для определения нажатия специальной клавиши}

repeat

key := ReadKey; {считываем символ нажатой клавиши}

case key of

chr(0): spec := true; {определяем специальную клавишу}

chr(27): {определяем нажатие Esc и завершаем цикл}

begin

if (spec = false) then done := true;

code := chr(27); {устанавливаем код возврата для процедуры удаления элемента из списка}

end;

chr(10), chr(13), chr(32): {определяем клавиши enter и пробел}

if (spec = false) then

begin

if (fltr)and(marker<>nil) then

ShowFilm(marker)

else

begin

key := chr(27); {заканчиваем внешний цикл выбором элемента}

code:=chr(13); {передаем код действия с выбранным элементом}

end;

done := true; {заканчиваем цикл нажатием управляющей клавиши}

end;

chr(72): {определяем перемещение курсора вверх}

if (spec = true) then

begin

spec := false; {сбрасываем флаг специальной клавиши}

done:=true; {заканчиваем цикл нажатием управляющей клавиши}

Prev(marker); {процедура перехода на предыдущий элемент}

end;

chr(80): {определяем перемещение курсора вниз}

if (spec = true) then

begin

spec := false; {сбрасываем флаг специальной клавиши}

done:=true; {заканчиваем цикл нажатием управляющей клавиши}

Next(marker); {процедура перехода на следующий элемент}

end;

else spec := false; {сбрасываем флаг специальной клавиши}

end;

until (done = true); {пока не нажата специальная клавиша}

end;

until (key = chr(27)); {пока не нажат Esc или Еnter или пробел}

Window(6,7,79,49); {область вывода текста}

ClrScr;

end;

procedure Search; {процедура поиска}

var marker:PointerSubjs;

key:char;

begin

fltr:=true;

WriteTitle(1,'Find film'); {выводим заголовок}

marker := SubjList;

filtering := true; {включаем фильтрацию}

setFilter := myFilter; {устанавливаем функциональную переменную в нужный фильтр}

WriteForm(2,3,@myFilterInfo); {заполняем поля, необходимые для фильтрации}

ShowList(15,'List of Found Films', marker,key); {вывод соответствующего списка}

fltr:=false;

end;

procedure RemoveSubj(marker:PointerSubjs);

{процедура удаления элемента}

var tmp:PointerSubjs;

begin

if(marker <> NIL) then

begin

{если элемент единственный}

if (marker^.UpPointer = nil) and (marker^.DownPointer = nil) then

begin

SubjList:=nil;

Dispose(marker);

end

else

if (marker^.UpPointer = NIL) then {удаление, если текущее звено первое}

begin

SubjList := marker^.DownPointer;

SubjList^.UpPointer := NIL;

Dispose(marker);

end

else

if (marker^.DownPointer = NIL) then {удаление, если текущее звено последнее}

begin

tmp := marker;

marker := marker^.UpPointer;

marker^.DownPointer := NIL;

Dispose(tmp);

end

else {удаление в остальных случаях, когда звено в середине списка}

begin

tmp := marker;

marker := marker^.UpPointer;

marker^.DownPointer := tmp^.DownPointer;

marker := marker^.DownPointer;

marker^.UpPointer := tmp^.UpPointer;

Dispose(tmp);

end;

end;

end;

procedure Remove; {процедура удаления элемента из списка}

var marker:PointerSubjs;

key:char;

begin

marker := SubjList;

filtering := false; {не используем функцию фильтрации для вывода всего списка}

ShowList(20,'Remove film', marker,key); {выводим по одному элементу из списка}

case key of {в зависимости от нажатой клавиши}

chr(13): begin{Enter}

RemoveSubj(marker); {если Еnter, то удаляем элемент}

WriteTitle(16, 'Film was removed');

end;

chr(27): begin WriteTitle(16,'Film was not removed'); {Еsc}

end;{если Esc, то заканчиваем процедуру без удаления}

end;

ReadKey;

end;

procedure ShowAll; {процедура вывода списка элементов}

var marker:PointerSubjs;

key:char;

begin

fltr:=true;

marker := SubjList;

filtering := false; {не используем функцию фильтрации для вывода всего списка}

ShowList(20,'Index of films', marker,key); {выводим список из 20 элементов}

fltr:=false;

end;

procedure IncludeSubj(Subj:PointerSubjs); {процедура вставки в список}

var marker:PointerSubjs;

begin

marker := SubjList;

while (marker^.Subject<Subj^.Subject)AND(marker^.DownPointer<>nil) do

marker := marker^.DownPointer;

if (marker^.UpPointer=nil) AND (marker^.Subject>Subj^.Subject)

then

begin

Subj^.DownPointer := marker;

marker^.UpPointer := Subj;

SubjList:=Subj;

end

else

if (marker^.DownPointer=nil) AND (marker^.Subject<Subj^.Subject)

then

begin

Subj^.UpPointer := marker;

marker^.DownPointer := Subj;

end

else

{в остальных случаях добавляем элемент в середину списка перед текущим звеном}

begin

Subj^.DownPointer := marker;

Subj^.UpPointer := marker^.UpPointer;

marker^.UpPointer := Subj;

marker := Subj^.UpPointer;

marker^.DownPointer := Subj;

end;

end;

procedure Add; {процедура добавления элемента в список}

var PSubj: PointerSubjs;

begin

WriteTitle(1,'Add film'); {выводим заголовок}

new (PSubj); {отводим память под новую динамическую переменную}

WriteForm(1,2,PSubj); {выводим и заполняем форму}

PSubj^.UpPointer := nil;

PSubj^.DownPointer := nil;

if SubjList=nil then SubjList := PSubj {присваиваем значение первому звену}

else IncludeSubj(PSubj); {добавляем элемент через процедуру вставки в список}

WriteTitle(16, 'Film was added');

ReadKey;

end;

procedure ClearList; {процедура очистки списка}

var marker:PointerSubjs;

begin

marker:=SubjList; {делаем текущим первый элемент списка}

if marker<>nil then

begin

while(marker^.DownPointer<>NIL) do {пока не достигнем конца списка}

begin

marker:=marker^.DownPointer; {делаем текущим следующий элемент списка}

Dispose(marker^.UpPointer); {удаляем предыдущий элемент}

end;

Dispose(marker); {удаляем последний элемент списка}

SubjList := NIL; {делаем указатель на первый элемент неопределенным}

end;

end;

procedure Load; {процедура загрузки из файла}

var f:file of Subjs; {задаем файловую переменную}

marker, tmp:PointerSubjs; {задаем указатели на запись}

begin

Assign(f,'data.flm'); {связываем логическое устройство с файловой переменной}

Reset(f); {открываем существующий файл}

ClearList; {вызываем процедуру очистки списка}

while(NOT EOF(f)) do {пока не достигли конца файла}

begin

New(tmp); {создаем новую динамическую переменную}

Read(f,tmp^); {заполняем значение переменной из файла}

tmp^.UpPointer := nil;

tmp^.DownPointer := nil;

if SubjList=nil then SubjList := tmp {присваиваем значение первому звену}

else IncludeSubj(tmp); {присваиваем значение следующему звену через процедуру вставки в список}

end;

Close(f); {закрываем файл}

WriteTitle(16,'Index of films was loaded from file data.flm');{выводим заголовок}

ReadKey;

end;

procedure Save; {процедура сохранения в файл}

var f:file of Subjs; {задаем файловую переменную}

marker:PointerSubjs;

begin

Assign(f,'data.flm'); {связываем логическое устройство с файловой переменной}

Rewrite(f); {создаем и открываем новый файл}

marker:=SubjList;

while(marker<>NIL) do {пока список не кончится}

begin

Write(f,marker^);

marker:=marker^.DownPointer; {переходим к следующему звену списка}

end;

Close(f); {обновляем и закрываем файл}

WriteTitle(16,'Index of films was saved to file data.flm'); {выводим заголовок}

ReadKey;

end;

procedure StartWork; {процедура определения обработки нажатой клавиши}

var key:char; spec,stop:boolean;

begin

spec := false; {параметр для определения нажатия спец. клавиши}

repeat

ClrScr;

key := ReadKey; {считываем поступающий с клавиатуры символ}

case key of

chr(0): spec := true; {определяем спец. клавишу}

chr(45): begin if (spec = true) then stop := true; end;

{определяем нажатие Alt+X и заканчиваем цикл}

chr(60): begin if (spec = true) then Save; spec := false; end;

{определяем нажатие F2 и вызываем процедуру Save}

chr(61): begin if (spec = true) then Load; spec := false; end;

{определяем нажатие F3 и вызываем процедуру Load}

'1': begin if (spec = false) then Add; end;

{определяем нажатие клавиши 1 и вызываем процедуру Add}

'2': begin if (spec = false) then Remove; end;

{определяем нажатие клавиши 2 и вызываем процедуру Remove}

'3': begin if (spec = false) then Search; end;

{определяем нажатие клавиши 3 и вызываем процедуру Search}

'4': begin if (spec = false) then ShowAll; end;

{определяем нажатие клавиши 4 и вызываем процедуру ShowAll}

else begin spec := false; end; {если символ не соответствует обрабатываемому, то сбрасываем флаг спец. клавиши}

end;

until (stop = true);

end;

procedure WriteMenuItem(num:integer;title:string);{процедура вывода подменю}

begin

TextColor(14); {цвет текста: 14 - жёлтый}

GotoXY(2,num); {перемещаем курсор в точку начала вывода}

Write(' ', num, ' '); {выводим номер пункта подменю}

TextColor(0); {задаем цвет текста: 0 - чёрный}

Write(title); {выводим пункт подменю}

end;

procedure InitCrt; {процедура подготовки экрана к работе}

begin

TextBackground(9); {цвет экрана: 9 - синий}

Window(1,1,80,1); {размеры текстового откна для данных настроек}

ClrScr; {очищаем и применяем настройки к заданному окну}

TextColor(14); {F2}

Write(' F2 ');

TextColor(15);

Write('Save');

TextColor(14); {F3}

Write(' F3 ');

TextColor(15);

Write('Load');

TextColor(14); {Alt+X}

Write(' Alt+X ');

TextColor(15);

Write('Exit');

TextBackground(3); {цвет экрана: 10 - зелёный}

Window(1,2,80,5); {определяем размеры текстового окна для данных настроек}

ClrScr; {очищаем и применяем настройки к заданному окну}

{в этом же окне выводим подменю с помощью процедуры вывода подменю}

WriteMenuItem(1,'Add film');

WriteMenuItem(2,'Remove film');

WriteMenuItem(3,'Find film');

WriteMenuItem(4,'All films');

TextBackground(15); {задаем цвет экрана: 15 - светлосерый}

TextColor(0); {задаем цвет текста: 0 - чёрный}

Window(1,6,80,50); {определяем размеры текстового окна для данных настроек}

ClrScr; {очищаем и применяем настройки к заданному окну}

Window(6,7,79,49); {область вывода текста}

end;

procedure Init; {процедура инициализации экрана}

begin

if (LastMode <> 3) AND (LastMode <> 259) then {проверка режима работы графического адаптора}

begin

WriteLn('You need graphic adaptor with 80x50 Color Mode Support');

Halt; {прекращение работы}

end;

TextMode(3 + 256); {установка режима работы Co80 + Font8x8}

end;

Begin{сообщение при окончании работы программы}

fltr:=false;

filtering:=false;

SubjList := NIL;

Init; {инициализация экрана}

InitCrt; {подготовка экрана к работе}

StartWork; {процедура определения обработки нажатой клавиши}

End.

Литература

1. Бородич Ю.С. Разработка программных систем на языке Паскаль: Справ. пособие. - Мн.: Вышэйшая школа, 1992.Кнут Д. Искусство программирования для ЭВМ, - Том 3 , «Сортировка и поиск».

2. Т.А.Павловская, «Паскаль. Программирование на языке высокого уровня».

3. Т.А.Павловская, «Паскаль. Программирование на языке высокого уровня. Практикум».

4. Фаронов В.В. Турбо Паскаль 7.0. Начальный курс. Учебное пособие. - М.: Нолидж, 1999.

Размещено на Allbest.ru