Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.02.2011, 20:04   #1
Zedefen
 
Регистрация: 25.08.2010
Сообщений: 4
Вопрос Не работает поиск по критериям!

Уважаемые программисты помогите пожалуйста доделать программу!
В программе все работает нормально кроме поиска по заданным критерия
(по названию работает по другим нет),не пойму что не правильно тут.

Задача:Вариант 7. "Библиотека"
Используя односвязный список, создать программу, которая содержит текущую информацию о книгах в библиотеке. Каждая компонента структуры содержит следующие сведения: номер УДК, фамилию и инициалы автора, название, год издания, количество экземпляров данной книги в библиотеке. При запуске программы список формируется на основе данных считанных из файла, затем сортируется по ключу (в качестве ключевого поля использовать номер УДК). При выходе из программы данные сохраняются в том же файле.
Реализовать следующие операции дня пользователя:
1) добавление данных о книгах, вновь поступающих в библиотеку или увеличение количества экземпляров;
2) удаление данных о списываемых книгах или уменьшения количества экземпляров;
3) поиск книги по номеру УДК. автору (предусмотреть вывод нескольких книг одного автора), названию;
4) вывод списка книг по году издания с организацией паузы для просмотра и возможностью прерывания просмотра.

программа:
Код:
uses crt,Libunit;
var
   exit_prog : boolean;
   c : char;
const
   fs = 'data.dat';

procedure view_menu;
begin
   clrscr;
   textcolor(2);
   writeln ('Библиотека');
   writeln('1. Добавить данные о книге');
   writeln('2. Удалить данные о книге');
   writeln('3. Поиск книги');
   writeln('4. Вывод списка книг');
   writeln('5. Выходи из программы');
end;

procedure view_find;
begin
   clrscr;
   textcolor(2);
   writeln ('Поиск книги: ');
   writeln('1. Поиск по автору');
   writeln('2. Поиск по УДК');
   writeln('3. Поиск по названию');
   writeln('4. В главное меню');
end;

procedure change_find;
var
   exit_menu : boolean;
   c : char;
begin
   clrscr;
   textcolor(2);
   exit_menu := false;
   while not (exit_menu)  do
     begin
       view_find;
       c:= readkey;
       case ord(c) of
         47: find_name;
         48: find_udk;
         49: find_author;
         50: exit_menu := true;
       end;
     end;
end;

begin
   read_file(fs);
   sort;
   exit_prog := false;
   while not (exit_prog)  do
     begin
       view_menu;
       c:= readkey;
       case ord(c) of
         49: new_book;
         50: del_book;
         51: change_find;
         52: show_all;
         53: exit_prog := true;
       end;
     end;
   write_file(fs);
end.
а это юнит к проге:
Код:
unit Libunit;

interface

TYPE
   PAv = ^TAv;

   TAv = record
      name : string[40];
      author : string[30];
      udk: integer;
      god : integer;
      kolvo : integer;
   end;

   PLib = ^TLib;

   TLib = record
      t : TAv;
      next : PLib;
   end;

var
   first,last : PLib;

procedure new_book;
procedure del_book;
procedure show_all;
procedure show_book (p: PAv);
procedure add_note(p: PLib);
procedure sort;
procedure read_file ( fs: string );
procedure write_file ( fs:string );
procedure find_name;
procedure find_udk;
procedure find_author;


implementation

uses crt;

procedure show_book(p:PAv);
begin
   if p<>nil then
   begin
      writeln ('Название: ',p^.name);
      writeln ('Автор: ',p^.author);
      writeln ('Номер УДК: ', p^.udk);
      writeln ('Год издания: ', p^.god);
      writeln ('Количество:', p^.kolvo);
   end;
end;

procedure show_all;
var
   p : Plib;
   i : integer;
   ya : boolean;
   c : char;
begin
   p := first;
   i := 1;
   ya := false;
   clrscr;
   writeln ('Все книги:');
   while ((p<>nil) and (ya<>true)) do
   begin
      writeln('Книга № ',i);
      show_book(@p^.t);
      writeln;
      writeln('Нажмите Esc для выхода или другую клавишу для продолжения.');
      writeln;
      c := readkey;
      if ord(c) = 27 then
        ya := true;
      p := p^.next;
      inc(i);
   end;
   clrscr;
   if ya = false then
   begin
      writeln('Список книг закончился');
      writeln('Нажмите Enter.');
      readln;
   end;
end;

procedure create_book(p: PAv);
begin
   clrscr;
   writeln ( 'Добавление книги' );
   writeln;
   write ('Название : ');
   readln (p^.name);
   write ('Автор  : ');
   readln (p^.author);
   write ('Номер УДК : ');
   readln (p^.udk);
   write ('Год издания  : ');
   readln (p^.god);
   write ('Количество  : ');
   readln (p^.kolvo);
end;

procedure add_note(p: PLib);
begin
   if first = nil then
     begin
       first := p;
       last := p;
     end
   else
     begin
       p^.next:=first;
       first:=p;
     end;
end;
Zedefen вне форума Ответить с цитированием
Старый 11.02.2011, 20:05   #2
Zedefen
 
Регистрация: 25.08.2010
Сообщений: 4
Сообщение продолжение юнита

Продолжение :
Код:
procedure sort;
var
   p,pp: PLib;
   tmp: TAv;
   x,i: integer;
begin
   p := first;
   x := 0;
   while p<>nil do
     begin
       inc (x);
       p := p^.next;
     end;
   if x>1 then
     begin
       for i:=1 to x do
         begin
           p:= first;
           while p^.next<>nil do
             begin
               pp:= p^.next;
               if p^.t.god > pp^.t.god  then
                 begin
                   tmp:= p^.t;
                   p^.t:= pp^.t;
                   pp^.t:= tmp;
                 end;
               p:= p^.next;
          end;
      end;
   end;
end;

procedure new_book;
var
   p : PLib;
   t : TAv;
begin
   create_book(@t);
   new(p);
   p^.next := nil;
   p^.t := t;
   add_note(p);
   sort;
   clrscr;
   writeln ('Добавлена новая книга:');
   show_book(@p^.t);
   writeln;
   writeln('Нажмите Enter.');
   readln;
end;
function change_book: PLib;
var
   i: integer;
   p: PLib;
   c: char;
   g,d: boolean;
begin
   p:= first;
   i:= 1;
   g:= true;
   d:= false;
   while (p<>nil) and (d<>true) do
   begin
      clrscr;
      writeln ('Удаление книги  :');
      writeln('Книга №,i');
      show_book(@p^.t);
      writeln;
      d := false;
      g := true;
      write('"Удалить книгу?(1-да , 2-нет) ');
      while g do
        begin
          c:=readkey;
          g:= true;
          case ord(c) of
            49:
              begin
                d:= true;
                g:= false;
              end;
            50:
              begin
                d:= false;
                g:= false;
              end;
         end;
   end;
      if d<>true then
        begin
          p:=p^.next;
          inc (i);
        end;
   end;
   change_book := p;
end;

procedure del_note(p : PLib);
var
   t : PLib;
begin
   if first<>nil then
     begin
       if p=first then
         begin
           if p<>last then
             first := p^.next
           else
             begin
               first := nil;
               last := nil;
         end;
      end
    else
      begin
        t := first;
        while t^.next <> p  do
          t:= t^.next;
        t^.next:= p^.next;
        if p=last then
          last := t;
      end;
    Dispose(p);
    p := nil;
  end;
end;

procedure del_book;
var
   p : PLib;
begin
   p := change_Book;
   clrscr;
   if p=nil then
     begin
       textcolor(14);
       writeln('Не выбрана книга для удаления или закончился список');
       textcolor(15);
       writeln('Нажмите Enter.');
       readln;
     end
   else
     begin
       del_note(p);
       textcolor(12);
       writeln('Книга успешно удалена. Нажмите Enter.');
       textcolor(15);
       readln;
     end;
end;

function exists_file ( fs: string ): boolean;
var
   f : file of TAv;
begin
   {$I-}
   assign(f,fs);
   reset(f);
   close(f);
   {$I+}
   exists_file := (IOResult = 0) and (fs<>'');
end;

procedure read_file ( fs: string );
var
   f : file of TAv;
   t : PLib;
begin
   assign(f,fs);
   if (exists_file(fs) = false) then
     rewrite(f)
   else
     reset(f);
   while not eof(f) do
     begin
       new(t);
       t^.next := nil;
       read(f,t^.t);
       add_note(t);
     end;
   close(f);
end;

procedure write_file ( fs:string );
var
   f : file of TAv;
   t : PLib;
begin
   assign(f, fs);
   rewrite(f);
   t := first;
   while t<>nil do
     begin
       write (f,t^.t);
       first := t^.next;
       Dispose(t);
       t := first;
     end;
   close(f);
end;
Zedefen вне форума Ответить с цитированием
Старый 11.02.2011, 20:06   #3
Zedefen
 
Регистрация: 25.08.2010
Сообщений: 4
По умолчанию

Продолжение:
Код:
procedure find_name;
var
   s: string;
   p: PLib;
   ya: boolean;
begin
   if first = nil then
     writeln('Нет данных для поиска')
   else
     begin
       write ('Введите название книги : ');
       readln(s);
       ya := false;
       p := first;
       while ((p<>nil) and (ya<>true)) do
         begin
           if p^.t.name = s then
             ya := true
           else
             p := p^.next;
         end;
       writeln;
       if p = nil then
         writeln ('Ничего не найдено')
       else
         begin
         show_book(@p^.t);
         writeln;
         writeln('Нажмите Enter');
         readln;
         end;
   end;
end;
procedure find_udk;
var
   s: integer;
   p: PLib;
   ya: boolean;
begin
   if first = nil then
     writeln('Нет данных для поиска')
   else
     begin
       write ('Введите УДК книги : ');
       readln(s);
       ya := false;
       p := first;
       while ((p<>nil) and (ya<>true)) do
          begin
            if p^.t.udk = s then
              ya := true
            else
              p := p^.next;
           end;
       writeln;
       if p = nil then
         writeln ('Ничего не найдено')
       else
         begin
         show_book(@p^.t);
         writeln;
         writeln('Нажмите Enter');
         readln;
         end;
   end;
end;
procedure find_author;
var
   s: string;
   p: PLib;
   ya: boolean;
begin
   if first = nil then
     writeln('Нет данных для поиска')
   else
     begin
       write ('Введите автора книги : ');
       readln(s);
       ya := false;
       p := first;
       while ((p<>nil) and (ya<>true)) do
           begin
             if p^.t.author = s then
               ya := true
             else
               p := p^.next;
           end;
       writeln;
       if p = nil then
         writeln ('Ничего не найдено')
       else
         begin
         show_book(@p^.t);
         writeln;
         writeln('Нажмите Enter');
         readln;
         end;
   end;
end;

begin
   first := nil;
   last := nil;
end.
Zedefen вне форума Ответить с цитированием
Старый 11.02.2011, 21:10   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

А в каком смысле не работают? Ты пошаговку делал?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 11.02.2011, 21:49   #5
Zedefen
 
Регистрация: 25.08.2010
Сообщений: 4
По умолчанию

Всё до меня доперло
теперь работает!
Zedefen вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
[B]Не работает бинарный поиск![/B] sabaton Общие вопросы C/C++ 2 21.09.2010 20:51
Неправильно работает поиск Власов А.С. БД в Delphi 5 12.10.2009 05:59
Поиск и отображение по критериям porfonya Microsoft Office Excel 7 05.06.2009 18:31
поиск по сайту не работает!!! ара JavaScript, Ajax 1 07.04.2009 17:20
поиск слов по критериям(нужна помощь..срочно) clabnk Помощь студентам 6 01.06.2008 18:23