Создание справочника "Парфюмерный магазин" при помощи программы Turbo Pascal

Рисунок – 1 -  схема списковой структуры - стек

Приложение 4 – Формат выходного документа.

Рисунок 1 – Разметка экрана

Рисунок 2 – Просмотр товаров

Рисунок 3 – Помощь

Рисунок 4 – Добавление товара

Рисунок 5 – Критерии поиска

Рисунок 6 – Отчет

Рисунок 7 – Выходной документ в файл

Приложение 5 – Схема последовательности обработки данных.

Схема 1 – Общая схема

Схема 2 – Разметка экрана

Схема 3 – вывод разделов и подразделов

                                                                                            Вверх

                                                            Вниз

Схема 4 – Перемещение по меню

                                        Enter                                           F1

     F3

Схема 5 – Выбор режима работы

     нет

                                             Да                    

Вход

                                        Вниз                     

Схема 6 - События по нажатию Enter

                                                     1                                 3

                                                                               2

                                                                                            нет

                                                            Да

                                                       Да

                                                                                     нет

                                                   Схема 7 - Поиск

                                                                                      Да

                                                     Нет

Схема 8 - Помощь

                                                                                       Операции

                                                                                                с товарами

                                        Передвижение

                                  PageDown                                          PageUp

                                                                                ESC

Схема 9 – Вывод товара на экран

Схема 10 – Вывод общего количества товаров

Схема 11 – Найти первый товар

Схема 12 – Добавить код товара в список

                                          Да

       нет

Схема 13 – Поиск следующего товара

                                                                                             Нет

                                            Да

Схема 14 – Добавление нового товара

                                                                                              Нет

                                                    Да

Схема 15 – Удаление товара

                             По товару                                               По подразделу

Схема 16 – Отчет по товарам

Приложение 6 Листинг программы

program parfum;

uses crt;

  type       {Список в котором содержатся код товаров}

  integ=^int;

  int=record

      nomer:integer; {Код товара}

      next:integ;    {Ссылка на следующий элемент}

    end;

var Nach:integ; {Начало списка}

    tek:integ; {Текущий элемент списка}

    d:integ;   {Переменная для работы со списком}

    i:integer; {Счетчик}

    ch:char; {Ввод с клавиатуры}

    Rozd:string; {Выбранный раздел}

    nabor:integer; {Счетчик числа элементов меню}

    men:array[1..16] of integer;{Массив вывода элементы Главного меню}

    strok, stolb:integer;{Пункты меню}

    lom:integer; {Переменная для работы с Главным меню}

    vof:boolean; {Переменная указывает что массив цветов уже заполнен}

    Razdel:integer;{Переменная которая указывает открытую главу}

    PodRazd:integer; {Переменная которая указывает открыт подраздел}

    MRazdel:integer; {Переменная которая указывает открыт раздел}

    stek:text;{Файл в который добавляется код товара}

    {KodStek:integer;}

    ScetRP:integer; {Счетчик позиций в указанном разделе и подразделе}

    hod:integer; {Ходы вверх вниз в списке}

    kolvo:integer; {Количество элементов в списке}

    Text1,Text2,Text3,Text4:string[19]; {Комментарии}

    f:text; {Файловая переменная}

    f1,f2,f3,f4,f8,pd,pu,f10:integer; {Цвета пунктов внизу экрана}

    Prin:boolean;{логическая переменная для печать текущей позиции}

 Baza:record                 {Переменные для работы с файлами}

       Fsim:string;          {Символ-разделитель}

       FKod:integer;         {Код товара}

       FRazdel:integer;      {Раздел}

       FPodRazdel:integer;   {Подраздел}

       FName:String;         {Название}

       FSeria:string;        {Серия}

       FProizvod:string;     {Производитель}

       FOpisan:string;       {Описание товара}

       FMany:string;         {Цена}

 end;

procedure shapka;  {Выводит разметку на экран, а именно горизонтальные и

                   вертикальные линии и кнопки управления внизу экрана,

                   а так же заголовок раздела и подраздела}

var MainName:string; {Название подраздела}

begin

GoToXY(30,1); Textcolor(14);

GoToXY(1,2);  Textcolor(11); For i:=1 to 80 do write('-');

   for i:=3 to 21 do

   begin

       GoToXY(20,i);  Textcolor(11); writeln('|');

   end;

   GoToXY(1,22); For i:=1 to 80 do write('-');

   GoToXY(1,23); Textcolor(F1); writeln('Помощь F1|');

   GoToXY(11,23); Textcolor(F2); writeln('Новый F2|');

   GoToXY(20,23); Textcolor(f3); writeln('Поиск F3|');

   GoToXY(29,23); Textcolor(f4); writeln('Отчет F4|');

   GoToXY(38,23); Textcolor(f8); writeln('Удалить F8|');

   GoToXY(49,23); Textcolor(pu); writeln('Назад PUp|');

   GoToXY(59,23); Textcolor(pd); writeln('Далее PDown|');

   GoToXY(71,23); Textcolor(f10); writeln('Выход F10');

   GoToXY(1,24); For i:=1 to 80 do write('-');

   GoToXY(1,17);  Textcolor(11); writeln('-------------------');

   if rozd='0'Then MainName:='ПАРФЮМЕРНЫЙ МАГАЗИН';

   if rozd='1'Then MainName:='УХОД ЗА ЛИЦОМ';

   if rozd='2'Then MainName:='УХОД ЗА КОЖЕЙ';

   if rozd='3'Then MainName:='ДЕТСКИЕ ТОВАРЫ';

   if rozd='4'Then MainName:='МАНИКЮР';

   if rozd='5'Then MainName:='ПАРФЮМЕРИЯ';

   if rozd='6'Then MainName:='УХОД ЗА ТЕЛОМ';

   if rozd='7'Then MainName:='ТОВАРЫ ДЛЯ МУЖЧИН';

   if rozd='8'Then MainName:='УХОД ЗА ВОЛОСАМИ';

   if rozd='9'Then MainName:='ДРУГИЕ ТОВАРЫ';

   GoToXY(30,1);  Textcolor(13);writeln(MainName);

   GoToXY(1,18);   Textcolor(12); writeln(Text1);

   GoToXY(1,19);  Textcolor(12); writeln(Text2);

   GoToXY(1,20);  Textcolor(12); writeln(Text3);

   GoToXY(1,21);  Textcolor(12); writeln(Text4);

end;

procedure podRazdel;  {Считывает из файла разделы и подразделы в

                      зависимости от выбранного и выводит на экран}

var PodRaz:array[1..16] of string;{Массив разделов и под разделов}

    z:integer; {Строка с которой начинается вывод пунктов меню}

    f:text;    {Файловая переменная}

    d:string;  {Переменная которой присваивается очередное считанное значение из файла}

begin

assign (f,'e:\prog\razdel.dat'); {Файл который содержит разделы и подразделы}

reset(f);

nabor:=0;

       while not Eof(f) do

       {До тех пор пока не конец файла делать

       если очередная строка файла соответствует выбранному разделу то

       записать ее в массив}

       begin

            Readln(f,d);

            if d=rozd then

            begin

                 nabor:=nabor+1;

                 Readln(f,d);

                 PodRaz[nabor]:=d;

            end

            else Readln(f,d);

       end;

close(f);

   {Вывод на экран пунктов и подпунктов меню из массива, закрашенных цветами

   из массива цветов}

   z:=3;

   for i:=1 to nabor do

   begin

        Textcolor(men[i]);

        GoToXY(2,z);

        writeln(PodRaz[i]);

        z:=z+1

   end;

end;

procedure ADDSpisok;{Добавляет в динамический список код товара, для

                               дальнейшего перемещения}

begin

      new(tek); {создаем новый элемент}

      tek^.nomer:=Baza.FKod;{записываем данное}

      tek^.next:=nach;{устанавливаем указатели}

      nach:=tek;   {для поддержания целостности списка}

      kolvo:=kolvo+1; {Увеличиваем количество добавленных элементов}

end;

procedure Tablo;

{Процедура выводит позиции товаров на экран}

var  opis1,opis2,opis3:string; {Разбивает строку на три части т.к. не влезает}

begin

          GoToXY(22,3);Textcolor(10);writeln('Kод товара ');

          GoToXY(33,3);Textcolor(11);writeln(Baza.FKod);

          GoToXY(43,3);Textcolor(10);writeln('Раздел ');

          GoToXY(50,3);Textcolor(11);writeln(Baza.FRazdel);

          GoToXY(60,3);Textcolor(10);writeln('Подраздел ');

          GoToXY(70,3);Textcolor(11);writeln(Baza.FPodRazdel);

          GoToXY(22,5);Textcolor(10);writeln('Название: ');

          opis1:=copy(Baza.FName,1,58);

          opis2:=copy(Baza.FName,59,117);

          opis3:=copy(Baza.FName,118,126);

          GoToXY(22,6);Textcolor(11);writeln(Opis1);

          GoToXY(22,7);Textcolor(11);writeln(Opis2);

          GoToXY(22,8);Textcolor(11);writeln(Opis3);

          GoToXY(22,10);Textcolor(10);writeln('Серия:');

          GoToXY(30,10);Textcolor(11);writeln(Baza.FSeria);

          GoToXY(22,12);Textcolor(10);writeln('Производитель:');

          GoToXY(22,13);Textcolor(11);writeln(Baza.FProizvod);

          opis1:=copy(Baza.FOpisan,1,58);

          opis2:=copy(Baza.FOpisan,59,117);

          opis3:=copy(Baza.FOpisan,118,126);

          GoToXY(22,15);Textcolor(10);writeln('Описание:');

          GoToXY(22,16);Textcolor(11);writeln(Opis1);

          GoToXY(22,17);Textcolor(11);writeln(Opis2);

          GoToXY(22,18);Textcolor(11);writeln(Opis3);

          GoToXY(22,20);Textcolor(10);writeln('Стоимость');

          GoToXY(35,20);Textcolor(11);writeln(Baza.FMany);

end;

procedure writeSpisok;  {Процедура вывода позиций товара чей код

                       последним записан в список}

var f:text;

begin

if  ScetRP<>0 then

begin

  tek:=nach;{Считать первый элемент списка и найти в файле товар с

                     таким кодом}

  assign(f,'e:\prog\bd.dat');

  reset(f);

    while not Eof(f) do   {Считываем из файла бд}

    begin

     readln(f,Baza.FKod);

     readln(f,Baza.FRazdel);

     readln(f,Baza.FPodRazdel);

     readln(f,Baza.FName);

     readln(f,Baza.FSeria);

     readln(f,Baza.FProizvod);

     readln(f,Baza.FOpisan);

     readln(f,Baza.FMany);

     readln(f,Baza.FSim);

     if Baza.FKod=tek^.nomer Then  {Если код товара из списка = коду товара

                             из файла значит вывести на экран позиции товара}

     begin

        clrscr;

          shapka; podRazdel;

          GoToXY(1,1); {write ('MRazdel=',MRazdel,'  Podrazd=',lom);}

          GoToXY(60,1); Write('Всего позиций: ',ScetRP);

          Tablo;

     end;

    end;

close(f);

end

else

 begin

      GoToXY(22,11);Textcolor(10);writeln('Товаров нет, для выхода из данной категории нажмите ESC');

      f1:=7;f2:=11;f3:=7;f4:=7;f8:=7;pu:=7;pd:=7;f10:=7; {Цвета нижних кнопок}

       Text1:='Двигайтесь кнопками';

       Text2:='PageDown,PageUp    ';       {Подсказки}

       Text3:='Для выхода нажмите ';

       Text4:='ESC                ';

      shapka;podrazdel;

      {writeln('Enter');

      readln;}

 end;

end;

procedure DelSpisok; {Удаляет последний элемент списка}

begin

  tek:=nach;   {Переходим в начало}

  nach:=tek^.next; {Связываем}

  dispose(tek);    {Удаляем}

  tek:=nach;

  kolvo:=kolvo-1;  {Уменьшаем количество элементов в списке на 1}

end;

procedure RP; {Считывает из файла первый товар соответствующий разделу

              и подразделу}

{var lon:boolean;

{    f:text;}

begin

{lon:=false;{}

assign (f,'e:\prog\bd.dat');

reset(f);

while (not Eof(f)) do

  begin

     readln(f,Baza.FKod);

     readln(f,Baza.FRazdel);

     readln(f,Baza.FPodRazdel);

     readln(f,Baza.FName);

     readln(f,Baza.FSeria);

     readln(f,Baza.FProizvod);

     readln(f,Baza.FOpisan);

     readln(f,Baza.FMany);

     readln(f,Baza.FSim);

     {Если раздел из файла = выбранному разделу и подраздел

     из файла=выбранному подразделу}

     If (Baza.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd) then

     begin

         addspisok; {Добавляем в список}

         break;

     end;

  end;

end;

procedure PoiskFPR; {Поиск элемента соответствующей разделу и

                    подразделу в списке и в файле}

var {f:text;}

    Good,Nal:boolean;

    zed:integer;

begin

assign (f,'e:\prog\bd.dat');

reset(f);

nal:=false;

  while (not Eof(f)) or (nal=false) do {Считывает данные из файла бд}

  begin

     readln(f,Baza.FKod);

     readln(f,Baza.FRazdel);

     readln(f,Baza.FPodRazdel);

     readln(f,Baza.FName);

     readln(f,Baza.FSeria);

     readln(f,Baza.FProizvod);

     readln(f,Baza.FOpisan);

     readln(f,Baza.FMany);

     readln(f,Baza.FSim);

     If ((Baza.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd)) then

     begin         {Если очередной товар в бд соответствует разделу и

                   подразделу тогда проверяется есть ли очередной код товара

                   в списке, если есть то ищет в бд следующий товар, если

                   нет то добавляет в список}

          zed:=0;

          Good:=false;

          d:=nil;

          tek:=nach;

          while (tek<>NIL) or (Good=false) do

          begin

               if tek^.nomer = Baza.FKod then Good:=true;

               d:=tek;

               tek:=tek^.next;

               zed:=zed+1;

               if zed=kolvo then break;

          end;

          if Good<>true  then

          begin

               nal:=true;

               break;

          end;

     end;

  end;

close(f);

end;

procedure schet; {Процедура выводит количество позиций в выбранном разделе

                 и подразделе}

{var f:text;{}

begin

ScetRP:=0;

  assign(f,'e:\prog\bd.dat');

  reset(f);

    while not Eof(f) do

    begin

          readln(f,Baza.FKod);

          readln(f,Baza.FRazdel);

          readln(f,Baza.FPodRazdel);

          readln(f,Baza.FName);

          readln(f,Baza.FSeria);

          readln(f,Baza.FProizvod);

          readln(f,Baza.FOpisan);

          readln(f,Baza.FMany);

          readln(f,Baza.FSim);

          if (Baza.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd) then

          ScetRP:=ScetRP+1;

    end;

close(f);

end;

Procedure Del; {Процедура удаление товара}

var FDel:text;{Временный файл для не удаленных товаров}

begin

GoToXY(27,21);Textcolor(21);

writeln('Вы действительно хотите удалить файл Y/N');

ch:=readkey;

if (ord(ch)=121) or  (ord(ch)=173) then

begin

assign(f,'e:\prog\bd.dat');

assign(fDel,'e:\prog\bdvr.dat');

reset(f);

rewrite(fdel);

while not Eof(f) do {Считывается очередной товар из бд}

         begin

         readln(f,Baza.FKod);

         readln(f,Baza.FRazdel);

         readln(f,Baza.FPodRazdel);

         readln(f,Baza.FName);

         readln(f,Baza.FSeria);

         readln(f,Baza.FProizvod);

         readln(f,Baza.FOpisan);

         readln(f,Baza.FMany);

         readln(f,Baza.FSim);

            If Baza.FKod<>tek^.nomer then  {Если текущая позиция в списке не

            равно текущему коду товара то все позиции товара переносятся

            во временный файл bddvr}

            begin

                 writeln(fdel,Baza.FKod);

                 writeln(fdel,Baza.FRazdel);

                 writeln(fdel,Baza.FPodrazdel);

                 writeln(fdel,Baza.FName);

                 writeln(fdel,Baza.FSeria);

                 writeln(fdel,Baza.FProizvod);

                 writeln(fdel,Baza.FOpisan);

                 writeln(fdel,Baza.FMany);

                 writeln(fdel,Baza.FSim);

            end

         end;

close(f);

close(fDel);

reset(fDel);

rewrite(f);

while not Eof(fDel) do {После переноса во временный файл, но уже без

          удаленного элемента происходит перезапись файла бд из временного}

         begin

                 readln(fDel,Baza.FKod);        writeln(f,Baza.FKod);

                 readln(fDel,Baza.FRazdel);     writeln(f,Baza.FRazdel);

                 readln(fDel,Baza.FPodRazdel);  writeln(f,Baza.FPodrazdel);

                 readln(fDel,Baza.FName);       writeln(f,Baza.FName);

                 readln(fDel,Baza.FSeria);      writeln(f,Baza.FSeria);

                 readln(fDel,Baza.FProizvod);   writeln(f,Baza.FProizvod);

                 readln(fDel,Baza.FOpisan);     writeln(f,Baza.FOpisan);

                 readln(fDel,Baza.FMany);       writeln(f,Baza.FMany);

                 readln(fDel,Baza.FSim);        writeln(f,Baza.FSim);

         end;

close(fdel);

close(f);

GoToXY(27,21);Textcolor(21); writeln('Запись удалена для продолжения работы нажмите ESC');

end;

if ord(ch)=110 then begin

GoToXY(27,21);Textcolor(21); writeln('Удаление отменено для продолжения работы нажмите ESC');

end;

end;

Procedure PrintF; {Процедура Печать в файл}

var fname1,fname2,fname3:string;  {Переменные указывающие путь к файлу}

    fotchet:text; {переменная файла отчета}

begin

clrscr;

GoToXY(10,10); Textcolor(11);writeln('Для печати всех позиций текущего подраздела нажмите F3');

GoToXY(10,12);writeln('Для печати текущей позиций нажмите F5');

GoToXY(10,14);writeln('Для выхода нажмите Backspace');

repeat

ch:=readkey;

            if (ord(ch)=61) or (ord(ch)=63) then {Вводится имя будущего

                               файла и создается шапка в файле отчета}

            begin

              fname1:='e:\prog\';

              fname3:='.txt';

              GoToXY(10,16);writeln('Введите имя файла в который необходимо сохранить отчет');

              GoToXY(10,17);writeln('и нажмите ввод. Файл отчета находится в корневой папке');

              GoToXY(10,19);readln(fname2);

              assign(fotchet,fname1+fname2+fname3);

              assign(f,'e:\prog\bd.dat');

              reset(f);

              rewrite(fotchet);

            end;

    if ord(ch)=61 then      {Если нажата F3 то создается отчет состоящий из

                            товаров текущего подраздела}

    begin

        writeln(fotchet,'Отчет по подразделу  ');

        writeln;

        writeln(fotchet,'---------------------------------------------------------');

        while not Eof(f) do

        begin

         readln(f,Baza.FKod);

         readln(f,Baza.FRazdel);

         readln(f,Baza.FPodRazdel);

         readln(f,Baza.FName);

         readln(f,Baza.FSeria);

         readln(f,Baza.FProizvod);

         readln(f,Baza.FOpisan);

         readln(f,Baza.FMany);

         readln(f,Baza.FSim);

         if (Baza.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd) then

         begin

              write (fotchet,'Код товара    '); writeln(fotchet,Baza.FKod);

              write (fotchet,'Название      ');writeln(fotchet,Baza.FName);

              write (fotchet,'Серия         ');writeln(fotchet,Baza.FSeria);

              write (fotchet,'Производитель ');writeln(fotchet,Baza.FProizvod);

              write (fotchet,'Описание      ');writeln(fotchet,Baza.FOpisan);

              write (fotchet,'Цена          ');writeln(fotchet,Baza.FMany);

              writeln(fotchet,'-----------------------------------------');

         end;

        end;

   close(fotchet);

   close(f);

   end;

   if ord(ch)=63 then {Если нажата F5 то в файл отчета добавляется только

                      текущая позиция}

   begin

        tek:=nach;

        writeln(fotchet,'Отчет по текущему товару');

        writeln;

        writeln(fotchet,'---------------------------------------------------------');

        while not Eof(f) do

        begin

         readln(f,Baza.FKod);

         readln(f,Baza.FRazdel);

         readln(f,Baza.FPodRazdel);

         readln(f,Baza.FName);

         readln(f,Baza.FSeria);

         readln(f,Baza.FProizvod);

         readln(f,Baza.FOpisan);

         readln(f,Baza.FMany);

         readln(f,Baza.FSim);

         if (Baza.FKod=tek^.nomer) then

         begin

              write (fotchet,'Код товара    '); writeln(fotchet,Baza.FKod);

              write (fotchet,'Название      ');writeln(fotchet,Baza.FName);

              write (fotchet,'Серия         ');writeln(fotchet,Baza.FSeria);

              write (fotchet,'Производитель ');writeln(fotchet,Baza.FProizvod);

              write (fotchet,'Описание      ');writeln(fotchet,Baza.FOpisan);

              write (fotchet,'Цена          ');writeln(fotchet,Baza.FMany);

              writeln(fotchet,'-----------------------------------------');

         end;

        end;

   close(fotchet);

   close(f);

   end;

until (ord(ch)=8) or (ord(ch)=61) or (ord(ch)=63);

{Закрыте файлов и вывод на прежнее место}

        clrscr;

        shapka;

        writespisok;

end;

procedure NewTovar; {Процедура добавления нового товара}

var f1,f2,f3:text; {Файловые переменные}

    kod:integer;   {Переменная которой присваивается новый код товара}

begin

clrscr;

Baza.FRazdel:=MRazdel; Baza.FPodRazdel:=PodRazd;

{Форма заполнения данных о новом товаре}

GoToXY(10,1); Textcolor(10); Writeln('Заполните форму. После заполнение очередного пункта нажмите ввод');

GoToXY(3,4); writeln('Раздел ',Baza.FRazdel);

GoToXY(3,5); writeln('Подраздел ',Baza.FPodRazdel);

GoToXY(3,6);  Writeln('Опешите назначение товара');

GoToXY(3,8);  Writeln('Введите серию товара, если нет то введите символ "-" ');

GoToXY(3,10); Writeln('Введите производителя');

GoToXY(3,12); Writeln('Опешите товар подробнее');

GoToXY(3,22); Writeln('Цена товара');

GoToXY(3,5); Textcolor(11);

GoToXY(3,7);readln(Baza.FName);

GoToXY(3,9);readln(Baza.FSeria);

GoToXY(3,11);readln(Baza.FProizvod);

GoToXY(3,13);readln(Baza.FOpisan);

GoToXY(20,22);readln(Baza.FMany);

GoToXY(10,23);Textcolor(10); Writeln('Сохранить Y, Отмена N');

ch:=readkey;

      if (ord(ch)= 121) or (ord(ch)= 173) then  {Если нажата Y на английском

      и Н на русском, то считывается из файла, который хранит коды товаров,

      запоминает последний, увеличивает на единицу и добавляет новый код

      в файл кодов}

      begin

            clrscr;

            assign(f2,'e:\prog\kod.dat');

            reset(f2);

            while not Eof(f2) do readln(f2,Kod);

            close(f2);

            Baza.FKod:=Kod+1;

            append(f2);

            write(f2,'');

            writeln(f2,Baza.FKod);

            close(f2);

            assign(f3,'e:\prog\bd.dat');

            {Записывает в БД информацию о новом товаре}

            append(f3);

            writeln(f3,Baza.FKod);

            writeln(f3,Baza.FRazdel);

            writeln(f3,Baza.FPodRazdel);

            writeln(f3,Baza.FName);

            writeln(f3,Baza.FSeria);

            writeln(f3,Baza.FProizvod);

            writeln(f3,Baza.FOpisan);

            writeln(f3,Baza.FMany);

            writeln(f3,'*');

            close(f3);

            GoToXY(18,12); writeln('Запись сохранена для продолжения нажмите ввод');

            readln;

      end;

clrscr;

shapka;

podRazdel;

GoToXY(27,21);Textcolor(21); writeln('Для продолжения работы нажмите ESC');

end;

procedure vivod; {Основная процедура вывода}

{Общий принцип: На экране появляется первый элемент выбранного раздела и подраздела

Далее пользователь при помощи кнопок PageUp PageDown перемещается по всем товарам}

var hod:integer; {Счетчик ходв}

begin

schet;    {Считать общее количество позиций}

       f1:=7;f2:=11;f3:=7;f4:=11;f8:=11;pu:=11;pd:=11;f10:=7; {Переменные цвета нижних кнопок}

       Text1:='Двигайтесь кнопками';

       Text2:='PageDown,PageUp';       {Подсказки}

       Text3:='Для выхода нажмите';

       Text4:='ESC';

RP; {Выводится первый товар}

hod:=1;   {Сделан первый ход}

writeSpisok; {Вывести на экран товар соответствующий коду товара из списка}

repeat

      ch:=readkey;

      if (ord(ch)=81) and (ScetRP<>0) then {Если нажата PageDown}

      begin

           if ScetRP<>hod then

           begin

             hod:=hod+1;

             PoiskFPR; {Считывается весь файл и проверяется соответствие каждого товара

                       разделу и подразделу и проверяет входит ли код товара в список

                       если входит то ищет дальше если нет то...}

             addspisok; {Если нет то добавляет в список}

             writeSpisok;  {Выводит товар соответствующий коду товара из списка}

           end;

      end;

      if (ord(ch)=73) and (ScetRP<>0)  then  {Если нажата PageUp}

      begin

          if hod<>1 then

          begin

            hod:=hod-1;

            DelSpisok;  {Удаляет последний элемент списка}

            writeSpisok; {Выводит уже другой последний элемент}

          end;

      end;

      if ord(ch)=60 then NewTovar; {Если нажата F2 то в данный раздел и подраздел ввести новый товар}

      if (ord(ch)=66) and (ScetRP<>0) then Del;{Если нажата клавиша F8, то процедура удаление товара}

      if (ord(ch)=62) and (ScetRP<>0) then PrintF;{Если нажата клавиша F4, то процедура создания отчета}

until ord(ch)=27;

end;

procedure Vhod; {Процедура обработки события по нажатию клавише ввод}

begin

   Lom:=1;

   if ord(ch)=13 then {Если нажат ввод}

   begin

        for i:=1 to nabor do

        begin

           if (men[i]=15)  then {Если текущий цвет белый то... }

           begin

                if razdel=1 then {Если открыт подраздел...}

                begin

                     podrazd:=Lom; {Присвоить подразделу его порядковый номер}

                     vivod;        {Вывод на экран}

                     kolvo:=0;

                end;

                if (Lom=1) and (razdel=0) then

                begin

                     rozd:='1'; {Номер раздела}

                     MRazdel:=1;{Номер подраздела}

                     razdel:=1; {Показывает что открыт подраздел, а не раздел}

                end;{Далее аналогично}

                if (Lom=2) and (razdel=0)  then begin rozd:='2'; MRazdel:=2; razdel:=1; end;

                if (Lom=3) and (razdel=0)  then begin rozd:='3'; MRazdel:=3; razdel:=1; end;

                if (Lom=4) and (razdel=0)  then begin rozd:='4'; MRazdel:=4; razdel:=1; end;

                if (Lom=5) and (razdel=0)  then begin rozd:='5'; MRazdel:=5; razdel:=1; end;

                if (Lom=6) and (razdel=0)  then begin rozd:='6'; MRazdel:=6; razdel:=1; end;

                if (Lom=7) and (razdel=0)  then begin rozd:='7'; MRazdel:=7; razdel:=1; end;

                if (Lom=8) and (razdel=0)  then begin rozd:='8'; MRazdel:=8; razdel:=1; end;

                if (Lom=9) and (razdel=0)  then begin rozd:='9'; MRazdel:=9; razdel:=1; end;

           end;

           Lom:=Lom+1;

        end;

   end;

   if ord(ch)=8 then {Если нажата <- то вернутся назад}

   begin

        rozd:='0'; {Открывает раздел}

        razdel:=0; {Показывает что открыт раздел}

   end;

podRazdel; {Процедура создание подразделов}

end;

procedure Poisk;

var punkt:integer; {Переменная ввода выбранного критерия поиска}

    NSP:string; {Переменная условия поиска}

    fol:integer; {Переменная счетчик}

begin

clrscr;

fol:=0; {Счетчик указывающий количество найденных позиций}

GoToXY(10,2);  Textcolor(10); Writeln('Выберете критерии поиска');

{GoToXY(10,3);  Writeln('и нажмите ввод');}

Textcolor(11); GoToXY(12,6); Writeln('1: Название');

GoToXY(12,8); Writeln('2: Серия');

GoToXY(12,10); Writeln('3: Производитель');

GoToXY(12,12); Writeln('4: Отмена');

repeat

ch:=readkey;

if (ord(ch)=49) or (ord(ch)=50) or (ord(ch)=51) then

begin

 {GoToXY(12,14); readln(punkt);}

 GoToXY(12,14);writeln('Введите условие и нажмите ввод');

 GoToXY(12,16);readln(nsp);

 assign(f,'e:\prog\bd.dat');

 reset(f);

      while (not Eof(f)) do {Считывает очередной товар}

         begin

            readln(f,Baza.FKod);

            readln(f,Baza.FRazdel);

            readln(f,Baza.FPodRazdel);

            readln(f,Baza.FName);

            readln(f,Baza.FSeria);

            readln(f,Baza.FProizvod);

            readln(f,Baza.FOpisan);

            readln(f,Baza.FMany);

            readln(f,Baza.FSim);

            If (Baza.FName=NSP) or (Baza.FSeria=Nsp) or (Baza.FProizvod=Nsp) then

            begin

               clrscr;

               Tablo;

               f1:=7;f2:=7;f3:=7;f4:=7;f8:=7;pu:=7;pd:=11; f10:=7; {Цвета нижних кнопок}

               Text1:='Двигайтесь кнопкой';

               Text2:='PageDown';        {Подсказка}

               Text3:='Для выхода нажмите';

               Text4:='ESC';

               Shapka;

               fol:=fol+1;

               repeat

               ch:=readkey;

               until (ord(ch)=81)  or (ord(ch)=27);

               f1:=11;f2:=7;f3:=11;f4:=7;f8:=7;pu:=7;pd:=11;f10:=11; {Цвета нижних кнопок}

               if ord(ch)=27 then break;

            end;

         end;

 close(f);

 clrscr;

 GoToXY(15,12);Textcolor(4);

         if fol>0 then writeln('Больше совпадений нет, для продолжения работы нажмите ввод')

         else writeln('Cовпадений нет, для продолжения работы нажмите ввод');

 readln;

 break;

end;

until ord(ch)=52;

 clrscr;

 Text1:='Двигайтесь курсором';

 Text2:='до нужного раздела';        {Подсказка}

 Text3:='и нажмите ВВОД';

 Text4:='Для возврата <-';

 Shapka;

 podRazdel;

end;

procedure  help;

var k:string;

    n:integer;

begin

    clrscr;

    n:=0;

    assign(f,'e:\prog\help.dat');

    reset(f);

    while not Eof(f) do {Считывает очередной товар}

    begin

       if (n=24) or (n=48) or (n=72) or (n=96) or (n=120) or (n=120) then readln;{ch:=readkey;}

         readln(f,k);

         writeln(k);

         n:=n+1;

    end;

    readln;

    close(f);

    clrscr;

    Shapka;

    podRazdel;

end;

procedure perem; {Процедура перемещает элементы меню}

begin

   {Массив цветов. Первый белый остальные зеленые}

   men[1]:=15; men[2]:=2; men[3]:=2; men[4]:=2; men[5]:=2; men[6]:=2; men[7]:=2;

    men[8]:=2;  men[9]:=2; men[10]:=2;men[11]:=2;men[12]:=2;men[13]:=2; men[14]:=2; men[15]:=2;

  repeat

   podRazdel; {Процедура вывода подразделов}

   strok:=1; {Текущая строка}

   GoToXY(79,1);

   ch:=readkey; {Просит ввести курсором направления движения}

   if (ord(ch)=80)  then {Если вниз тогда текущий становится белым,

                         а нижний становится зеленым}

   begin

    for i:=1 to nabor do

    begin

      if (men[i]=15) and (strok<>nabor) then

      begin

          men[strok]:=2;

          men[strok+1]:=15;

      end

      else strok:=strok+1;

    end;

   end;

   if ord(ch)=72 then     {Если вверх, то текущий белым, а верхний зеленым}

   begin

     for i:=1 to nabor do

     begin

      if (men[i]=15) and (strok<>1)then

      begin

          men[strok]:=2;

          men[strok-1]:=15;

      end

      else strok:=strok+1;

     end;

   end;

   if ord(ch)=59 then Help; {Если нажата клавиша F1}

   if ord(ch)=61 then Poisk;{Если нажата клавиша F3}

{До тех пор пока не нажат ввод или назад или выход}

  until (ord(ch)=13) or (ord(ch)=8) or (ord(ch)=68);

  vof:=true;

  if (ord(ch)<>68) then  vhod;{Если не нажат выход то вход в очередной раздел или подраздел}

end;

{Основная программа}

begin

 rozd:='0'; {Подраздел не выбран, значит выводить главный раздел}

 razdel:=0; {Показывает что открыт раздел, а не подраздел}

 vof:=false; {Переменная показывает что перемещений не было}

 repeat

       clrscr;

       f1:=11;f2:=7;f3:=11;f4:=7;f8:=7;pu:=7;pd:=7;f10:=11; {Цвета нижних кнопок}

       Text1:='Двигайтесь курсором';

       Text2:='до нужного раздела';        {Подсказка}

       Text3:='и нажмите ВВОД';

       Text4:='Для возврата <-';

       shapka; {Процедура выводит разметку на экран}

       GoToXY(79,1);

       perem;          {Процедура перемещения курсором в разделах и подразделах}

 until (ord(ch)=68) ; {До тех пор пока не нажат пункт EXIT}

end.