Программа Склад, База данных учёта товаров. Опции

[Begin]

Добрый вечер!
Программа компилируется,работает,но не удаляет,не ищет и не редактирует товар.Пишет что товар не найден.

program sklad;
 
uses
   crt;
 
const
   n_items = 7;
   l_name = 30;
 
type
   str_name = string[l_name];
   pTovar = ^Tovar;
   Tovar = record
      name: str_name;
      kolvo: integer;
      cena: real;
      next: pTovar;
      prev: pTovar;
   end;
 
var
   DefaultMode,
   ActiveColor, InactiveColor: word;
   key: char;
   item: word;
   prev: word;
   beg: pTovar;
   fin: pTovar;
   p: pTovar;
   name: str_name;
   tovr: Tovar;
 
procedure Add(var beg, fin: pTovar; const tovr: Tovar); forward;
 
procedure Clear; forward;
 
procedure Del(var beg, fin, p: pTovar); forward;
 
procedure DlgWindow; forward;
 
procedure DrawItem(item, color: word); forward;
 
procedure Edit(beg: pTovar; const tovr: Tovar); forward;
 
procedure Error(message: string); forward;
 
function Find(p: pTovar; const tovr:str_name): pTovar; forward;
 
procedure Info(const tovr: Tovar); forward;
 
procedure InitMenu(ActvieColor, InactiveColor: word); forward;
 
procedure Message(message: string); forward;
 
procedure Query(var tovr: Tovar); forward;
 
procedure QueryName(var name: str_name); forward;
 
procedure ReadFile(var beg, fin: pTovar); forward;
 
procedure Select(beg: pTovar); forward;
 
procedure ShowBase(beg: pTovar); forward;
 
procedure Add(var beg, fin: pTovar; const tovr: Tovar);
var
   p: pTovar;
begin
   new(p);
   p^ := tovr;
   p^.next := nil;
   p^.prev := fin;
   if beg = nil then beg := p
   else fin^.next := p;
   fin := p;
end;
 
procedure Clear;
begin
   window(1, 3, 80, 25);
   TextColor(White);
   Clrscr;
end;
 
procedure Del(var beg, fin, p: pTovar);
begin
   if (p = beg) and (p = fin) then
   begin
      beg := nil;
      fin := nil;
   end
   else
   if p = beg then begin
      beg := beg^.next;
      beg^.prev := nil
   end
   else
   if p = fin then begin
      fin := fin^.prev;
      fin^.next := nil;
   end
   else
   begin
      p^.prev^.next := p^.next;
      p^.next^.prev := p^.prev;
   end;
   dispose(p);
end;
 
procedure DlgWindow;
begin
   window(10, 6, 70, 12);
   TextColor(Green);
   TextBackground(LightGray);
   clrscr;
end;
 
procedure DrawItem(item, color: word);
const
   d = 12;
   items: array[1..n_items] of string[d] = ('Vivod bazi dannix', 'Dobavlenie',
   'Izmenenie', 'Udalenie', 'Poisk', 'Vibor', 'Vixod');
   pos: array[1..n_items] of integer = (1 , d + 2, 2 * d + 3, 3 * d + 3, 4 * d + 3, 5 * d + 0, 6 * d - 6);
begin
   window(1, 1, 80, 2);
   TextBackGround(LightGray);
   TextColor(Color);
   gotoXY(pos[item], 1);
   write(items[item]);
end;
 
procedure edit(beg: pTovar; const tovr: Tovar);
var
   p: pTovar;
begin
   p := Find(beg, tovr.name);
   if p <> nil then begin
      p^.kolvo := tovr.kolvo;
      p^.cena := tovr.cena;
   end;
end;
 
procedure error(message: string);
begin
   window(1, 1, 80, 25);
   TextColor(Red);
   clrscr;
   gotoXY(35, 12);
   write(message);
   repeat 
   until keypressed;
   TextMode(DefaultMode);
   halt;
end;
 
function Find(p: pTovar; const tovr:str_name): pTovar;
begin
   while p <> nil do
   begin
      if tovr=p^.name then
      begin
         Find := p;
         exit;
      end;
      p := p^.next;
   end;
   Message('Tovar ne naiden');
   Find := nil;
end;
 
procedure Info(const tovr: Tovar);
begin
   DlgWindow;
   with tovr do
   begin
      gotoXY(2, 2);
      writeln('Nazvanie tovara:', name);
      gotoXY(2, 4);
      writeln('Kolichestvo tovara:', kolvo);;
      gotoXY(2, 6);
      writeln('Cena tovara:', cena);
   end;
   readln;
end;
 
procedure InitMenu(ActvieColor, InactiveColor: word);
var
   item: word;
begin
   window(1, 1, 80, 2);
   TextBackGround(lightGray);
   clrscr;
   DrawItem(1, ActiveColor);
   for item := 2 to n_items do DrawItem(item, InactiveColor);
   gotoXY(1, 2);
   TextColor(InactiveColor);
   write('----------------------------------------------------------------------');
   gotoXY(1, 1);
end;
 
procedure Message(message: string);
begin
   DlgWindow;
   gotoXY(2, 4);
   write(message);
   readln;
end;
 
procedure Query(var tovr: Tovar);
var
   s: string;
   err: integer;
   i, len: integer;
begin
   DlgWindow;
   with tovr do 
   begin
      repeat
         gotoXY(2, 2);
         write('Nazvanie Tovara:     ');
         clreol;
         readln(name);
         len := length(name);
         for i := len + 1 to l_name do name := name + ' ';
      until len <> 0;
      repeat
         gotoXY(2, 4);
         write('Kolichestvo tovara:    ');
         clreol;
         readln(s);
         val(s, kolvo, err);
      until(err = 0) and (kolvo > 0);
      repeat
         gotoXY(2, 6);
         write('Cena tovara:         ');
         clreol;
         readln(s);
         val(s, cena, err);
      until(err = 0) and (cena > 0);
   end;
end;
 
procedure QueryName(var name: str_name);
var
   i, len: integer;
begin
   DlgWindow;
   gotoXY(2, 2);
   write('Nazvanie tovara:                 ');
   clreol;
   readln(name);
   len := length(name);
   for i := len + 1 to l_name do name := name + '';
end;
 
procedure ReadFile(var beg, fin: pTovar);
var
   f: text;
   tovr: Tovar;
begin
   {$I-}
   assign(f, 'bazatovarov.txt');
   rewrite(f);
   reset(f);
   if (IOResult <> 0) then Error('Fail bazatovarov.txt ne naiden');
   {$I+}
   while not eof(f) do
   begin
      with tovr do 
         readln(f, name, kolvo, cena);
      Add(beg, fin, tovr);
   end;
   close(f);
end;
 
procedure Select(beg: pTovar);
    
   procedure QueryCena(var cena: real);
   var
      s: string;
      err: integer;
   begin
      DlgWindow;
      repeat
         gotoXY(2, 4);
         write('Cena tovara: ');
         clreol;
         readln(s);
         val(s, cena, err);
      until (err = 0) and (cena > 0);
   end;
 
var
   begs, fins: pTovar;
   p: pTovar;
   cena: real;
begin
   QueryCena(cena);
   begs := nil;
   fins := nil;
   p := beg;
   while p <> nil do 
   begin
      if p^.cena > cena then Add(begs, fins, p^);
      p := p^.next;
   end;
   ShowBase(begs);
end;
 
procedure ShowBase(beg: pTovar);
const
   step = 18;
   
   procedure ShowPage(var p: pTovar);
   var
      i: integer;
   begin
      clrscr;
      gotoXY(1, 1);
      writeln('Nazvanie tovara           Kolichestvo Tovara             Cena Tovara');
      i := 0;
      while p <> nil do 
      begin
         with p^ do 
            writeln(' ', name, kolvo:5, cena:15:2);
         p := p^.next;
         inc(i);
         if i > step then exit;
      end;
   end;
 
var
   i: integer;
   key: char;
   p, pn: pTovar;
begin
   if beg = nil then
   begin
      Message('Spisok pyst');
      exit
   end;
   window(3, 4, 78, 24);
   TextBackGround(LightGray);
   TextColor(white);
   p := beg;
   while true do
   begin
      pn := p;
      ShowPage(p);
      key := readkey;
      if key = #0 then key := readkey;
      case ord(key) of
         27: exit;
         13, 80{down}, 81: if p = nil then p := pn;
         72, 73{up}:
            begin
               p := pn;
               for i := 1 to step do
               begin
                  p := p^.prev;
                  if p = nil then
                  begin
                     p := beg;
                     break
                  end;
               end;
            end;
      end;
   end;
end;
 
begin
   DefaultMode := LastMode;
   TextMode(C80);
   beg := nil;
   fin := nil;
   ReadFile(beg, fin);
   clrscr;
   ActiveColor := LightGreen;
   InactiveColor := Green;
   InitMenu(ActiveColor, InactiveColor);
   item := 1;
   prev := 1;
   while true do 
   begin
      key := readkey;
      if key = #0 then key := readkey;
      case ord(key) of
         13:
            case item of
               1: ShowBase(beg);
               2:
                  begin
                     Query(tovr);
                     Add(beg, fin, tovr);
                  end;
               3:
                  begin
                     Query(tovr);
                     Edit(beg, tovr);
                  end;
               4:
                  begin
                     QueryName(name);
                     p := Find(beg, name);
                     if p <> nil then Del(beg, fin, p);
                  end;
               5:
                  begin
                     QueryName(name);
                     p := Find(beg, name);
                     if p <> nil then Info(p^);
                  end;
               6: Select(beg);
               7: exit;
            end;
         15{Shift+Tab}, 75{Left}:
            begin
               prev := item;
               dec(item);
               if item = 0 then item := n_items;
            end;
         9{Tab}, 77{Right}:
            begin
               prev := item;
               inc(item);
               if item = n_items + 1 then item := 1; end;
      end;
      Clear;
      DrawItem(prev, InactiveColor);
      DrawItem(item, ActiveColor);
   end;
   TextMode(DefaultMode);
end. 

[Begin]

Тему можно закрыть))