Quick sort ( быстрая сортировка) очереди

program Program_5;
uses crt;
type
ukazatel = ^rec;
rec = record
      nomlist:word;
      dt:string[10];
      gosnomer:string[20];
      p_n:string[20];
      probeg:integer;
      sled:ukazatel;
      end;
 
var   f:file of rec;
      head,p,q,head2,p2,q2:ukazatel;
      i,j,m:integer;
      menu:byte;
      c:char;
      s:string;
procedure show_menu;
begin
clrscr;
gotoxy(25,3);
writeln('Сведения о пробеге автомобилей');
gotoxy(28,5);
writeln('Основное меню программы');
gotoxy(29,8);
writeln('1 - создание новой БД');
gotoxy(29,10);
writeln('2 - Открытие БД из файла');
gotoxy(29,12);
writeln('3 - Сохранение БД в файл');
gotoxy(29,14);
writeln('4 - Просмотр БД');
gotoxy(29,16);
writeln('5 - Добавление записей в БД');
gotoxy(29,18);
writeln('6 - Удаление записей из БД');
gotoxy(29,20);
writeln('7 - Выдать информацию по пробегу за месяц');
gotoxy(29,22);
writeln('8 - Выход из программы');
end;
 
procedure create_bd; // создание новой базы данных
begin
clrscr;
writeln('Создана новая База данных. Введите информацию:');
writeln('(признак конца ввода - введите 0 в номере путевого листа)');
new(head);
write('Номер путевого листа: ');
readln(head^.nomlist);
write('Дата путевого листа: ');
readln(head^.dt);
if (length(head^.dt)<>10)or(pos('.',head^.dt)<>3)
then
    repeat
          write('Неверная дата! Введите дату путевого листа: (dd.mm.gggg) ');
          readln(head^.dt);
    until (length(head^.dt)=10)and(pos('.',head^.dt)=3);
write('Госномер автомобиля ');
readln(head^.gosnomer);
write('Пункт назначения: ');
readln(head^.p_n);
write('Пробег :');
readln(head^.probeg);
head^.sled:=nil;
q:=head;
write('Номер путевого листа: ');
readln(i);
 
while i<>0 do
begin
     new(p);
     p^.nomlist:=i;
     write('Дата путевого листа ');
     readln(p^.dt);
     if (length(p^.dt)<>10)or(pos('.',p^.dt)<>3)
     then
         repeat
               write('Неверная дата! Введите дату путевого листа: (dd.mm.gggg) ');
               readln(p^.dt);
         until (length(p^.dt)=10)and(pos('.',p^.dt)=3);
     write('Госномер автомобиля ');
     readln(p^.gosnomer);
     write('Пункт назначения: ');
     readln(p^.p_n);
     write('Пробег :');
     readln(p^.probeg);
     p^.sled:= nil;
     q^.sled:= p;
     q:= q^.sled;
     write('Номер путевого листа: ');
     readln(i);
 
end;
end;
procedure load_bd; // загрузка из файла
begin
clrscr;
writeln('Загрузка Базы Данных из файла');
writeln;
write('Введите название файла: ');
readln(s);
If FileExists(s)=false then
begin
     writeln('Файл не найден');
     while keypressed do readkey;
     readkey;
     exit;
end;
assign(f,s);
reset(f);
new(head);
read(f,head^);
head^.sled:=nil;
q:=head;
while not eof(f) do
begin
     new(p);
     read(f,p^);
     p^.sled:= nil;
     q^.sled:= p;
     q:= q^.sled;
end;
close(f);
while keypressed do readkey;
writeln('База Данных загружена');
readkey;
 
end;
//---------------------------------------------
procedure save_bd; // запись в файл
begin
clrscr;
if head=nil then
begin
     writeln('База данных не создана');
     readkey;
     exit;
end;
writeln('Сохранение Базы Данных в файл');
writeln;
write('Введите название файла: ');
readln(s);
assign(f,s);
rewrite(f);
p:= head;
while p<>nil do
begin
     write(f,p^);
     p:= p^.sled; {переход к следующему элементу списка}
end;
close(f);
while keypressed do readkey;
writeln('Файл успешно сохранен');
readkey;
end;
//---------------------------------------------
procedure list_bd; // просмотр базы данных
begin
clrscr;
writeln('Просмотр Базы Данных');
writeln;
writeln('№ листа     дата       госномер            пункт назначения         пробег');
writeln('--------------------------------------------------------------------------');
p:= head;
s:='                                                                  ';
 
while p<>nil do
begin
     writeln(p^.nomlist,copy(s,1,10-length(inttostr(p^.nomlist))),p^.dt,'   ',p^.gosnomer+copy(s,1,20-length(p^.gosnomer)),p^.p_n+copy(s,1,20-length(p^.p_n)),'     ',p^.probeg);
     p:= p^.sled; {переход к следующему элементу списка}
end;
readkey;
end;
 
procedure add_bd;  //  добавление данных
begin
clrscr;
if head=nil then
begin
     writeln('База данных не создана');
     readkey;
     exit;
end;
writeln('Добавление новых записей. Введите информацию:');
writeln('(признак конца ввода - введите 0 в номере путевого листа)');
q:= head;
while q^.sled<>nil do
      q:= q^.sled; {переход к следующему элементу списка}
 
write('Номер путевого листа: ');
readln(i);
while i<>0 do
begin
     new(p);
     p^.nomlist:=i;
     write('Дата путевого листа: ');
     readln(p^.dt);
     if (length(p^.dt)<>10)or(pos('.',p^.dt)<>3)
     then
         repeat
               write('Неверная дата! Введите дату путевого листа: (dd.mm.gggg) ');
               readln(p^.dt);
         until (length(p^.dt)=10)and(pos('.',p^.dt)=3);
     write('Госномер автомобиля ');
     readln(p^.gosnomer);
     write('Пункт назначения: ');
     readln(p^.p_n);
     write('Пробег :');
     readln(p^.probeg);
     p^.sled:= nil;
     q^.sled:=p;
     q:= q^.sled;
     write('Номер путевого листа: ');
     readln(i);
 
 end;
end;
 
procedure delete_bd;
begin
clrscr;
if head=nil then
begin
     writeln('База данных не создана');
     readkey;
     exit;
end;
 
repeat
     clrscr;
     writeln('Удаление записей из Базы Данных. Для выхода из режима введите 0.');
     writeln;
     writeln('№   № листа     дата       госномер            пункт назначения         пробег');
     writeln('------------------------------------------------------------------------------');
     p:= head;
     s:='                                                                  ';
     i:=0;
     while p<>nil do
     begin
          inc(i);
          writeln(i,'    ',p^.nomlist,copy(s,1,10-length(inttostr(p^.nomlist))),p^.dt,'  ',p^.gosnomer+copy(s,1,20-length(p^.gosnomer)),p^.p_n+copy(s,1,20-length(p^.p_n)),'     ',p^.probeg);
          p:= p^.sled; {переход к следующему элементу списка}
     end;
     writeln;
     writeln('Какую запись необходимо удалить ?');
     readln(j);
     if (j>i)or(j=0) then continue;
     if j=1 then // если удаляем голову
     begin
          head:=head^.sled;
     end
     else  // если удаляем любой другой элемент
     begin
          i:=1;
          p:= head; {начать с головы списка}
          while i<>j-1 do
          begin
               p:= p^.sled; {поиск}
               inc(i);
          end;
          q:= p^.sled; {удаляемый элемент}
          p^.sled:= q^.sled; {связка "через один"}
          dispose(q);
     end;
until (j=0)or(head=nil);
 
end;
 
 
procedure show_info;
begin
clrscr;
if head=nil then
begin
     writeln('База данных не создана');
     readkey;
     exit;
end;
write('Введите месяц :');
readln(m);
write('Введите суммарный пробег: ');
readln(j);
// ------- создаем новый список -----------------
new(head2);
head2^.nomlist:=head^.nomlist;
head2^.dt:=head^.dt;
head2^.gosnomer:=head^.gosnomer;
head2^.p_n:=head^.p_n;
head2^.probeg:=head^.probeg;
head2^.sled:=nil;
 
p:= head^.sled;
while p<>nil do
begin
     p2:=head2;
     i:=0;
     while (p2<>nil)and(i=0) do
     begin
           if (p2^.gosnomer=p^.gosnomer)and(strtoint(copy(p2^.dt,4,2))=strtoint(copy(p^.dt,4,2))) then
           begin
                i:=1;
                p2^.probeg:=p2^.probeg+p^.probeg
           end;
           p2:=p2^.sled;
     end;
     if i=0 then    // такой автомобиль не найден - вставляем его в список 2
     begin
          p2:=head2;
          q:=head2;
          while (p2<>nil)and(p2^.gosnomer<=p^.gosnomer) do
          begin q:=p2;
                p2:=p2^.sled;
          end;
          //if p2=nil then p2:=q;
          p2:=q;
          new(q2);
          q2^.nomlist:=p^.nomlist;
          q2^.dt:=p^.dt;
          q2^.gosnomer:=p^.gosnomer;
          q2^.p_n:=p^.p_n;
          q2^.probeg:=p^.probeg;
 
          if (p2=head2)and(p2^.gosnomer>p^.gosnomer) then  // если вставляем в начало
          begin
 
               q2^.sled:=p2;
               head2:=q2;
          end
          else
 
              if p2^.sled=nil then      // если вставляем в конец
              begin
 
                   q2^.sled:= nil;
                   p2^.sled:=q2;
              end
          else
          begin
 
               q2^.sled:=p2^.sled;
               p2^.sled:=q2;
          end;
 
     end;
p:= p^.sled; {переход к следующему элементу списка}
end;
 
//-------- выдаем список 2 на экран ------------------
//clrscr;
writeln('Просмотр Базы Данных');
writeln;
writeln('№ листа   госномер                 пробег');
writeln('-----------------------------------------');
p:= head2;
s:='                                                                  ';
assign(f,'info');
rewrite(f);
while p<>nil do
begin
if (p^.probeg>=j)and(strtoint(copy(p^.dt,4,2))=m) then
begin
     writeln(p^.nomlist,copy(s,1,10-length(inttostr(p^.nomlist))),p^.gosnomer+copy(s,1,20-length(p^.gosnomer)),'     ',p^.probeg);
     write(f,p^);
end;
p:= p^.sled; {переход к следующему элементу списка}
end;
close(f);
 
while keypressed do readkey;
readkey;
// --- уничтожаем второй список за ненадобностью
p:= head2;
while p<>nil do
begin
     q:=p;
     p:= p^.sled; {переход к следующему элементу списка}
     dispose(q);
end;
end;
 
begin  // основная программа ---------------------------------------------------
head:=nil;
menu:=0;
while menu=0 do
begin
     show_menu;
     c:=readkey;
     case c of
          '1': create_bd;
          '2': load_bd;
          '3': save_bd;
          '4': list_bd;
          '5': add_bd;
          '6': delete_bd;
          '7': show_info;
          '8': menu:=1;
      end;
     while keypressed do readkey;
end;
   clrscr;
 
end.