Й способ. Unit2 c операциями меню.

unit Unit2; //модуль с основными операциями

interface

uses Unit1;//подключаем модуль с дековыми операциями

procedure FreeDeq(var a:deq); //очистка дека

procedure AddFromFile(var a:deq);//добавить из текстового файла

procedure AddElem(var a:deq); //добавить элемент

procedure ChangeDirection(var a:deq); //сменить направление

procedure delete(var a:deq); //обработать элемент (удалить)

procedure Filtration(var a:deq; out b:deq);//фильтрация

implementation

uses sysutils;

procedure FreeDeq(var a:deq); //очистка дека

var info:tstruct; //буфер

begin

while not check(a) do //пока дек не пустой

info:= get(a); //обрабатываем первый элемент (удаляем)

addlog('Очистка дека',a);//вывод результатов в лог файл

end;

procedure AddFromFile(var a:deq); //добавить из текстового файла

var f:textfile;j,n:byte;r:tstruct;//файловая переменная,буфер, вспомогат. перем.

begin

AssignFile (f, 'inp.txt');//подключаем текстовый файл

try Reset (f);//открываем для чтения

try

try

readln (f, n); //считываем количество вводимых элементов

for j:=1 to n do

begin

with r do //считываем данные необходимое кол-во раз

begin

readln(f, Title);

readln(f, Hours);

readln(f, Minutes);

readln(f, Seconds);

end;

add(a,r);//добавляем в дек

end;

except addlog('Error reading input file.',a)end;//в случае ошибки записи

finally CloseFile (f); //обязательно закрыть текстовый файл

addlog('Ввод из файла.',a); end;//вывод в лог файл результатов

except addlog('Error opening input file.',a);end;//в случае ошибки чтения

end;

procedure AddElem(var a:deq);//добавить элемент

var r:tstruct; flag:boolean;//буфер

begin

with r do //получаем в интеррактивном режиме данные

begin

write('Наименование заказа: ');

readln(Title);

write('Часы поступления: ');

readln(Hours);

write('Минуты поступления: ');

readln(Minutes);

write('Секунды поступления: ');

readln(Seconds);

end;

flag:=false;

if (r.Hours<0) then begin writeln('Часы не могут быть меньше нуля.'#$0D#$0A); r.Hours:=0; flag:=true; end;

if (r.Hours>23) then begin writeln('Часы не могут быть больше 23.'#$0D#$0A); r.Hours:=23; flag:=true; end;

if (r.Minutes<0) then begin writeln('Минуты не могут быть меньше нуля. '#$0D#$0A); r.Minutes:=0; flag:=true; end;

if (r.Minutes>59) then begin writeln('Минуты не могут быть больше 59. '#$0D#$0A); r.Minutes:=59; flag:=true; end;

if (r.Seconds<0) then begin writeln('Секунды не могут быть меньше нуля. '#$0D#$0A); r.Seconds:=0; flag:=true; end;

if (r.Seconds>59) then begin writeln('Секунды не могут быть больше 59. '#$0D#$0A); r.Seconds:=59; flag:=true; end;

begin

add(a,r); //добавляем в дек

if flag=true then addlog('Добавление элемента.Сделана корректировка.',a) else

addlog('Добавление элемента.',a); //вывод в лог файл результатов

end;

end;

procedure ChangeDirection(var a:deq);//сменить направление

begin

if not check(a) then changedir(a) //если не пустой меняем направление

else writeln('Дек пуст.');//иначе выводим соотв. сообщение

addlog('Изменение направления.',a);//выводим в лог файл результаты

end;

procedure delete(var a:deq); //обработать элемент (удаление)

var j,m:byte;info:tstruct; //буфер, вспомогательные переменые

begin

write('Сколько удалить?'); readln(m);J:=0;//ввод в интеррактивном режиме

while (not check(a)) and (j<m) do //до тех пор пока не пустой или

begin info:=get(a);inc(j);end;//пока не удалим нужное кол-во.

addlog('Удаление элементов.',a);//обрабатываем первый элемент (удаляем)

end;//выводим в лог файл результат

procedure Filtration(var a:deq; out b:deq);//фильтрация

var r:tstruct; buf:deq; first, second:integer;

begin

first:= 15*3600+20*60+35;

second:= 18*3600+50*60+10;

if not check(a) then //если не пустой

begin

while not check(a) do //то пока он не пустой

begin

r:=get(a);//обрабатываем первый элемент

if ((r.Hours*3600+r.Minutes*60+r.Seconds>=first) AND (r.Hours*3600+r.Minutes*60+r.Seconds<=second) AND (r.Hours>=0) AND (r.Hours<=23) AND (r.Minutes>=0) AND (r.Minutes<=59) AND (r.Seconds>=0) AND (r.Seconds<=59)) then

add(buf,r)//если соотв. усл., то добавляем в буфер

else

add(b,r); //иначе добавляем во второй дек

end;

while not check(buf) do //пока буфер не пустой

begin

r:=get(buf);add(a,r);//перемещаем елементы обратно в основной дек

end;

addlog('Фильтрация. Условие выполнено.',a); //вывод в лог файл

addlog('Фильтрация. Условие не выполнено.', b);//вывод второго дека

end else //если пустой, то выводим соотв. сообщение

begin

writeln('Дек пуст');addlog('Фильтрация. Неудача',a);

end;

end;

end.

Дата добавления: 2015-07-08