Ошибка Unexpected end of file

[nemq]

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;

[nemq]

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;

[nemq]

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;

[nemq]

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;

[nemq]

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 {После переноса во временный файл, но уже без
          удаленного элемента происходит перезапись файла бд из временного}

[nemq]

         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

[nemq]

         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 на английском
      и Н на русском, то считывается из файла, который хранит коды товаров,
      запоминает последний, увеличивает на единицу и добавляет новый код
      в файл кодов}

[nemq]

      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;

[nemq]

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;

[nemq]

    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.