Доработать И Исправить Ошибку В Информационно-справочной Системе

Тема в разделе "Pascal and Delphi", создана пользователем Noya, 26 ноя 2012.

Наш партнер Genesis Hackspace
Статус темы:
Закрыта.
  1. Noya

    Noya Гость

    Помогите пожалуйста доработать программу.
    Условие задачи: Разработать информационно-справочную систему коммерческих магазинов города. Предусмотреть поиск названия магазина и его адрес по названию товара. Результатом поиска является отсортированный в порядке возрастания стоимости искомого товара список магазинов. Данные располагать в динамической памяти компьютера в виде связанного списка.
    НАДО добавить чтобы было 2 связанных списка: 1-магазин, адрес; 2-товар,цена.
    например: Магазин1 Адрес1 товар1 цена1
    товар2 цена2
    Магазин2 Адрес2 ..... .............
    Заранее Спасибо за помощь!!!
    Вот моя написанная программа:

    uses crt;
    type TList=^TNode;
    tlist2=^tnode2;
    sv=record
    mag,adre:string[150];
    kod:integer;
    end;
    sv2=record
    ntov:string[200];
    cena,kod:longint;
    end;
    TNode=record info:sv; next:TList;
    end;
    tnode2=record info:sv2;next:tlist2;end;
    var
    f: file of sv;
    f2:file of sv2; {f - Файл с базой данных}
    List:TList;
    list2:tlist2; {list - переменная списка}
    a,b:sv; {a - переменная для временного хранения записи,b-переменная для хранения критерия для отбора}
    a2,b2:sv2;
    i,kol,w,nb:integer; {i - переменная для цикла ввода авто,kol - перменная колличества авто для создания базы}
    {w - переменная меню, nb - переменная для поиска определенной записи}

    Procedure ListInit (var L:TList);
    begin
    l:=nil;
    end;

    Procedure ListClear (var L:TList);
    var e:TList;
    begin
    While l<>nil do
    begin
    e:=l;
    l:=l^.next;
    dispose(e);
    end;
    end;
    Procedure ListInit2 (var L2:TList2);
    begin
    l2:=nil;
    end;

    Procedure ListClear2 (var L2:TList2);
    var e:TList2;
    begin
    While l2<>nil do
    begin
    e:=l2;
    l2:=l2^.next;
    dispose(e);
    end;
    end;


    Procedure AddLast (var L:TList; c:sv);
    var q,p:Tlist;
    begin
    New(q);
    q^.info:=c;
    q^.next:=nil;
    if l=nil then l:=q
    else
    begin
    p:=l;
    while p^.next<>nil do
    p:=p^.next;
    p^.next:=q;
    end;
    end;

    Procedure AddLast2 (var L:TList2; c:sv2);{Добавление узла в конец списка}
    var q,p:Tlist2;
    begin
    New(q); {Создание узла}
    q^.info:=c; {Добавление в него информации}
    q^.next:=nil; {Присвоение ему конца}
    if l=nil then l:=q {Если список пустой, то присвоить ему узел}
    else
    begin
    p:=l; {Чтобы не потерять начало списка}
    while p^.next<>nil do {Перебор списка до предпоследнего элемента}
    p:=p^.next; {Перход к следующему}
    p^.next:=q; {Добавление элемента}
    end;
    end;

    Procedure Wwod(var L:TList; var l2:tlist2); {Создание списка}
    var p:tlist;n:tlist2;
    begin
    ListClear(list); {Очищение старого списка}
    ListInit(list); {Инициализация нового}
    ListClear2(list2); {Очищение старого списка}
    ListInit2(list2);
    Writeln(' '); { запись информации}
    Writeln('Кол-vo magazinov: ');
    Readln(kol);
    for i:=1 to kol do
    begin
    Writeln(' magazin',i);
    with a do
    begin
    kod:=i;
    writeln('Название mag ');
    readln(mag);
    writeln('adres ');
    readln(adre);
    {writeln('naz tovara - ');
    readln(ntov);
    writeln('Цена - ');
    readln(cena);}

    end;
    addlast(l,a); {Добавление информации в конец списка}
    end;
    p:=l;
    while p<>nil do
    begin
    writeln('Kol-vo tovara v magazine - ',p^.info.mag,' = ');
    readln(kol);
    for i:=1 to kol do begin
    with a2 do
    begin
    kod:=p^.info.kod;
    writeln('name tovara - '); readln(ntov);
    writeln('Cena - ');readln(cena);
    end;
    addlast2(l2,a2); end;
    p:=p^.next;
    end;
    Writeln;
    end;

    Procedure ListPrint (L:TList;l2:tlist2); {Вывод списка на экран}
    begin
    writeln(' naz mag adres naz tovara Цена ');
    While l<>nil do {Перебор списка до конца}
    begin
    with l^.info do {Блок вывода информации из элемента}
    begin
    write (mag:5,' ',adre:10);
    while (kod=l2^.info.kod) and (l2<>nil) do begin
    writeln(' ',l2^.info.ntov,' ',l2^.info.cena);
    l2:=l2^.next;
    end;
    end;
    l:=l^.next; {Переход к следующему}
    end;
    Writeln;
    Writeln('Нажмите Enter для продолжения');
    readln;
    clrscr;
    end;

    Procedure SaveIt(L:TList;l2:tlist2); {Сохранение списка в файл}
    begin
    assign(f,'kati.dat');
    rewrite(f);
    assign(f2,'kati2.dat'); {На перезапись}
    rewrite(f2);
    While l<>nil do {Перебор списка}
    begin
    write(f,l^.info); {Запись информационной части в файл}
    while l^.info.kod=l2^.info.kod do
    begin
    write(f2,l2^.info);
    l2:=l2^.next;
    end;
    l:=l^.next; {Переход к следующему элементу}
    end;
    close(f);
    close(f2);
    end;

    {procedure Moder(var L:TList); {Изменение записи}
    {var p:tlist;
    begin
    i:=0;
    writeln('номер magazine - ');
    readln(nb);
    p:=l;
    while p<>nil do {Перебор списка}
    {begin
    inc(i);
    if i=nb then {Если номер найден тогда}
    {begin { перезаписываем элемент}
    {with a do begin
    writeln('Название mag ');
    readln(mag);
    writeln('adres ');
    readln(adre);
    writeln('naz tovara - ');
    readln(ntov);
    writeln('Цена - ');
    readln(cena);
    end;
    p^.info:=a; {Запись информации в элемент}
    {end;
    p:=p^.next; {Следующий элемент списка}
    {end;
    Writeln;
    Writeln('Модернизация записи завершена (нажмите Enter для продолжения )');
    Writeln;
    Readln;
    SaveIt(list);
    end;}

    {Procedure Dob(var L:TList); {Добавление новой записи}
    {begin
    Writeln;
    writeln('Введите данные об magazine:');
    with a do begin
    writeln('Название mag ');
    readln(mag);
    writeln('adres ');
    readln(adre);
    writeln('naz tovara - ');
    readln(ntov);
    writeln('Цена - ');
    readln(cena);
    end;
    AddLast(l,a); {Добавление в конец}
    {Writeln;
    Writeln('Нажмите Enter для продолжения');
    Writeln;
    Readln;
    SaveIt(list);
    end;}

    Procedure Sort(var q:TList; var q2:tlist2);
    var p,n:TList;
    c:sv;
    p2,n2:tlist2;
    c2:sv2;
    begin
    p:=q;
    p2:=q2;

    while p2<>nil do {Перебор всего списка}
    begin
    n2:=p2;

    while n2<>nil do
    begin {Перебор спика без элементов из 1 цикла}
    if p2^.info.cena>=n2^.info.cena then
    begin
    c2:=p2^.info;
    p2^.info:=n2^.info;
    n2^.info:=c2;

    c:=p^.info;
    p^.info:=n^.info;
    n^.info:=c;
    p:=p^.next;
    n:=n^.next;
    end;

    n2:=n2^.next; {следующий элемент 2 цикла}
    end;
    p2:=p2^.next; {следующий элемент 1 цикла}
    end;

    clrscr;
    ListPrint(q,q2);

    end;


    Procedure Sort2(var L:TList;l2:tlist2);
    var p,n:TList;
    p2,n2:tlist2;
    krit:integer;
    c:sv;c2:sv2;
    it:string;
    begin
    p:=nil;p2:=nil;

    n:=l; n2:=l2;
    writeln('naz tovara dli poiska'); readln(it);
    while n<>nil do
    begin
    while n^.info.kod=n2^.info.kod do
    begin
    if n2^.info.ntov=it then begin c:=n^.info; addlast(p,c); c2:=n2^.info; addlast2(p2,c2);end;
    n2:=n2^.next;
    end;
    n:=n^.next;
    end;
    sort(p,p2);
    end;



    begin
    w:=0;
    ListInit(list); { считываем информацию из файла и записываем ее в список}
    listinit2(list2);
    i:=1;

    assign(f,'kati.dat');
    reset(f);
    While not eof(f) do
    begin
    inc(i);
    read(f,a);
    AddLast(list,a);
    end;
    close(f);

    assign(f2,'kati2.dat');
    reset(f2);
    While not eof(f2) do
    begin
    inc(i);
    read(f2,a2);
    AddLast2(list2,a2);
    end;
    close(f2);
    while w<>7 do begin
    writeln(' меню программы:');
    writeln('1-Создание базы данных');
    writeln('2-Полный список mag');
    {writeln('3-Модернизация информации oб mag');
    writeln('4-poisk po nazvan');
    writeln('5-Добавление mag'); }
    writeln('6-poisk tovarov po nazvaniu');
    writeln('7-Выход из программы');
    write(' Ваш выбор- ');
    readln(w); clrscr;
    case w of
    1:Wwod(list,list2);
    2:ListPrint(list,list2);
    {3:Moder(list); }
    {4:Sort(list);}
    {5:Dob(list);}
    6:Sort2(list,list2);
    end;
    clrscr;
    end;
    SaveIt(list,list2); {Перезапись списка в файл}
    ListClear(List); {Очищение списка}
    listclear2(list2);
    clrscr;
    writeln('Программа завершена!');
    end.
     

    Вложения:

    • ka5ti.pas
      Размер файла:
      9,9 КБ
      Просмотров:
      9
  2. nayke

    nayke Well-Known Member

    Регистрация:
    4 авг 2010
    Сообщения:
    310
    Симпатии:
    0
    множество текста и ничего конкретного.
    Непонятно даже delphi это или паскаль.
    Пишите что конкретно не получается.
     
  3. Noya

    Noya Гость

    Это ПАскаль!
    у меня сейчас в данной программе выходит ошибка разыменование 0 указателя...
    а так мне надо сделать чтобы у 1го магазина было несколько товаров. а не 1...
     
  4. nayke

    nayke Well-Known Member

    Регистрация:
    4 авг 2010
    Сообщения:
    310
    Симпатии:
    0
    С указателями давно не работал - не подскажу, да и смысл их использовать.

    Делаете первую record/class

    Код (Text):
    TProduct=record
    Caption:string;
    price:longint;
    //etc
    end;
    и вторую

    Код (Text):
    TShop=record
    Caption:string;
    Address:string;
    Products: array of TProduct;
    //etc
    end;
    вроде это имели ввиду
     
  5. Noya

    Noya Гость

    Спасибо за помощь!!!

    Все работает, за исключением сортировки...
    Procedure Sort(var q:TList); {Процедура отбора по критериям}
    var p,n:TList;
    c:sv;
    z:string[15];
    cc:integer;
    begin
    p:=q;
    while p<>nil do {Перебор всего списка}
    begin
    n:=p;

    while n<>nil do
    begin {Перебор спика без элементов из 1 цикла}
    for i:=1 to n^.info.k do
    begin
    if p^.info.tov.cena>=n^.info.tov.cena then
    begin
    cc:=p^.info.tov.cena;
    z:=p^.info.tov.ntov;
    p^.info.tov.cena:= n^.info.tov.cena;
    p^.info.tov.ntov:=n^.info.tov.ntov;
    n^.info.tov.cena:=cc;
    n^.info.tov.ntov:=z;
    {p^.info:=n^.info;
    n^.info:=c; }
    end;
    end;
    n:=n^.next; {следующий элемент 2 цикла}
    end;
    p:=p^.next; {следующий элемент 1 цикла}
    end;

    clrscr;
    ListPrint(q);

    end;


    Procedure Sort2(var L:TList); {Процедура сортировки по критериям}
    var p,n:TList;

    krit:integer;
    c:sv;
    it:string;
    begin
    p:=nil;

    n:=l;
    writeln('naz tovara dli poiska'); readln(it);
    while n<>nil do
    begin
    for i:=1 to n^.info.k do
    begin
    if n^.info.tov.ntov=it then begin c:=n^.info; addlast(p,c);end;
    end;
    n:=n^.next;
    end;
    listprint(p);readln;

    sort(p);
    end;

    НАДО
    Результатом поиска является отсортированный в порядке возрастания стоимости искомого товара список магазинов.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей