Й способ. Unit 1 с операциями над деком.

unit Unit1;

interface

type

TStruct = record // сведения о заказе

Title: string; // наименование заказа

Hours: integer; // часы поступления

Minutes: integer; // минуты поступления

Seconds: integer; // секунды поступления

end;

PElem =^TElem;

TElem = record

info: Tstruct; //данные

next,prev: PElem //указатель на следующий/предыдуший

end;

Deq = record

listB,ListE: PElem; //указатель на начало/конец

end;

const

nul: TStruct = (//нулевой элемент

Title: ' ';

Hours: 0;

Minutes: 0;

Seconds: 0;

);

function Check(a:deq):boolean; //проверка на пустоту

procedure CreateDeq(var a:deq); //создание дека из одного элемента

procedure Add(var a:deq; r:tstruct); //добавить в конец

function Get(var a:deq):tstruct; //обработать первый элемент и удалить

procedure ChangeDir(var a:deq); //смена направления

procedure addlog(s:string; a:deq);//вывод в лог фаил

implementation

uses SysUtils;

function Check(a:deq):boolean; //проверка на пустоту

begin

if (a.listB = nil) or (a.listE = nil) then

result:=True //если указатель на начало

else

result:=false; //или на конец списка равен nil, то список пуст

end;

procedure CreateDeq(var a:Deq); //создать дек из одного нулевого элемента

var elem:pelem; //вспомогательный указатель

begin

new(elem); //выделение памяти

elem^.next:= nil;

a.listB:= elem; //после элемента ничего нет;этот елемент первый

elem^.prev:= nil;

a.listE:= a.listB; //перед эл-том ничего нет; он последний

elem^.info:= nul; //в даные записываем нулевой элемент

end;

procedure Add(var a:deq; r:TStruct);//добавление в начало

var elem:pelem; //вспомогательный элемент

begin

if check(a) then //если пустой, то создаем и в данные записываем

begin

createDeq(a);

a.listb^.info:= r; // введенное значение

end

else //если не пустой

begin

new(elem); //выделяем память(создаем новый)

elem^.info:= r; //в данные записываем введенное значение

elem^.prev:= a.listE; //предыдущий за новым - хвост

a.listE^.next:= elem; //следующий за хвостом - новый

a.listE:= elem; //текущий элемент делаем последним

a.listE^.next:= nil; //за хвостом дека ничего нет

end;

end;

function Get(var a:deq):tstruct; //обработка первого эл-та(удаление)

var

r: tstruct;

elem: pelem; //буфер данных и вспомогательный указатель

begin

if check(a) then

result:=nul //если дек пуст - возвращаем нулевой элемент

else

if a.listB=a.listE then //иначе, если начало и конец совпадают

begin

r:= a.listb^.info; //считываем значение

dispose(a.listB); //удаляем

a.listB:= nil;

a.listE:= nil; //и начало значение nil

result:= r; //выводим значение

end

else //если не совпадают

begin

elem:= a.Listb; //ставим вспомогательный указатель на начало списка

r:=elem^.info; //считываем данные из эл-та

a.Listb:=Elem^.next; //первый элемент теперь следующий после первого

dispose (elem); //удаляем бывший первый

a.listB^.prev:=nil; //перед новым первым ничего

result:=r; //выводим значение предыдущего первого

end;

end;

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

var i,elem:pelem; //вспомогательные указатели

begin

elem:=a.listB; //устанавливаем вспомогательный элемент на начало

while elem<>nil do //пока список не закончился

begin

i:=elem; //второй вспомогательный указывает на первый вспомогательный

elem:=elem^.next;//первый вспомогательный указывает на след. после него

i^.next:=i^.prev;//меняем связи местами. Следущий теперь предыдущий

i^.prev:=elem;//и наоборот.Предыдущий теперь следующий

end;

a.liste:=a.listb;a.listB:=i; //меняем местами указатель на начало и конец

end;

procedure addlog(s:string; a:deq);//вывод в лог фаил

var i:pelem; F:textFile;//вспомогательный указатель и файловая переменная

begin

assignfile (f, 'log.txt');//подключаем лог файл

try if fileexists('log.txt') then //если лог файл существует - дописать

append(f) else Rewrite(F); //иначе создать

try

try

WriteLn(F,DateTimeToStr(Now) + ': ');//дата, время

writeln (f,s); //заголовок лог файла

if check(a) then writeln (f,'Дек пуст.')//если пуст, то выводим соотв.

else begin //если нет: вспомогательный указатель на начало

i:=a.listb;

while i<>nil do //пока список не закончился

begin

with i^.info do //выводим данные

begin

writeln(f, 'Наименование заказа: ', Title);

writeln(f, 'Часы поступления: ', Hours);

writeln(f, 'Минуты поступления: ', Minutes);

writeln(f, 'Секунды поступления: ', Seconds);

end;

writeln(f);i:=i^.next;//переход на новую строку и к следующему эл-ту

end;

end;

except writeln ('Eror writing log file.');end;//вывод в случае ошибки записи

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

except Writeln ('Eror opening log file.');end;//вывод в случае ошибки чтения

end;

end.

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