Й способ. Unit1 c базовыми операциями.

unit Unit1; //модуль с базовыми операциями

interface

type

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

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

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

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

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

end;

mas = array of TStruct; //динамический массив из записей

deq = record

data:mas; //массив с данными

begl,endl:byte;// индекс начала/конца

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.data=nil then result:=True//если массив пуст, то true

else result:=false;//иначе false

end;

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

begin

setlength(a.data,11);a.data[0]:=nul;//выделение памяти с запасом, нулевой эл-т

a.begl:=0;a.endl:=0;; //инедксы начала и конца устанавливаем на ноль

end;

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

begin

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

begin createDeq(a); a.data[a.begl]:=r; end// в первый эл-т данные

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

begin //если в конце есть запас памяти, то добавляем в конец

if a.endl+1 < length(a.data) then begin inc(a.endl);a.data[a.endl]:=r;end

else

begin//если нет запаса в конце

if a.endl+1=length(a.data) then begin

inc(a.endl);setlength(a.data,a.endl+1); //то выделяем новую память

a.data[a.endl]:=r;//и вводим данные в конечный элемент

end;

end;

end;

end;

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

var r:tstruct; i: byte; //буфер

begin

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

else //иначе

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

begin r:=a.data[a.begl];//считываем данные

setlength(a.data,0); result:=r;end//обнуляем массив и выводим данные

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

begin r:=a.data[a.begl];//считываем данные

for i:=a.begl+1 to a.endl do //сдвигаем элементы в начало

a.data[i-1]:=a.data[i]; dec(a.endl); //уменьшаем индекс конечного

setlength(a.data,a.endl+1); //выделяем на один элемент меньше памяти

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

end;

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

var i:byte; buf:tstruct;//вспомогательный индекс, буффер данных

begin

for i:=0 to (a.endl-a.begl)div 2 do//от первого элемента до середины

begin

buf:=a.data[a.begl+i];//заносим в буфер данные первого

a.data[a.begl+i]:=a.data[a.endl-i];//вводим в первый данные последнего

a.data[a.endl-i]:=buf;//вводим в последний данные первого и т.д.

end;

end;

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

var i:byte; 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.begl;//вспомогательный индекс на начало

while i<=a.endl do //пока дек не закончился

begin

with a.data[i]do//выводим данные

begin

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

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

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

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

end;

writeln(f);inc(i);//переход на новую строку и к следующему элементу

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