13.05.2018, 21:54 | #1 (permalink) |
Новичок
Регистрация: 13.05.2018
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Необходимо ввести и сохранить в файле данные следующей структуры
наименование товара, фирма изготовитель, срок хранения, стоимость товара, количество на складе. Организовать просмотр исходных данных и вывести список товаров, количество на складе которых не меньше заданного, отсортированный по возрастанию методом пузырька, с указанием срока хранения и стоимости. Ввод и вывод данных организовать в виде таблиц. Отладку программы производить на примере файла, состоящего не менее чем из 15 записей. Код:
uses crt; Function IOResult : Integer; const g=6; type Tablica=record Name:string[40]; //Название товара Fir:integer; //Фирма изготовитель Srok:integer; //Срок хранения Stoim:string[20]; // Стоимость товара Kol:integer; //Количество на складе end; var users:file of Tablica; // Сам файл k:1..g; // Счетчик для массива work:array[1..g] of Tablica; //Массив записей для дальнейшей сортировки NewTabl:string[15]; // Имя файла n:1..4; // Кол-во для CASE i:integer; Procedure Name_file_for_tabl; // Задаем имя файла begin write('Введите имя файла данных '); Readln(NewTabl); End; Procedure error(var i:integer); //Для ошибок связанных с отсутствием файла begin Name_file_for_tabl; Assign(users,NewTabl); {$I-} //Проверка на то, что файл существует Reset(users); {$I+} if IOResult<>0 then begin Writeln('Файла с именем '+NewTabl+' на диске нет'); i:=999; delay(5000); clrscr; end else i:=0; end; procedure input; // Происходит ввод файла begin Name_file_for_tabl; // Спрашиваем имя assign(users, NewTabl); rewrite(users); //Создаем новый файл или перезаписываем for var k:= 1 to g do begin with work[k] do begin writeln ('Введите наименование товара: '); readln(Name); writeln ('Введите фирму изготовителя: '); readln (Fir); writeln ('Введите срок хранения: '); readln(Srok); writeln ('Введите стоимость товара: '); readln(Stoim); writeln ('Введите количество товара: '); readln(Kol); end; write(users,work[k]); end; close(users); //Закрываем файл. writeln('1 - Дальше. 2 - Выход'); readln(n); if n=2 then halt(1); end; Procedure OutputRec; //Вывод одиночной записи. Begin Read(users,work[k]); with work[k] do begin write('Запись №',FilePos(users),';'); Writeln('Наименование товара: ',Name); Writeln('Фирма изготовитель: ',Fir); Writeln('Срок хранения: ',Srok); Writeln('Стоимость товара: ',Stoim); Writeln('Количество товара: ',Kol); writeln(); end; end; procedure OutputAllRec; //Читает все записи begin error(i); if i=999 then exit; writeln('Вывод базы данных из файла ',NewTabl); for var k :=1 to g do if (not Eof(users)) then //Чтение до конца строки OutputRec; //Вывод отдельных записей writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*'); writeln('| Наименование товара | Фирма изготовитель | Срок хранения | Стоимость товара | Количество товара |'); writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*'); for var k:=1 to g do //Сортировка writeln('|', work[k].Name:40,'|',work[k].Fir:20,'|', work[k].Srok:15, '|', work[k].Stoim:20, '|', work[k].Kol:19, '|'); writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*'); close(users);//Закрываем файл. writeln('1 - Дальше. 2 - Выход'); readln(n); if n=2 then halt(1); end; Procedure Sort; //Сортировка по возрастанию методом пузырька. var x:Tablica; begin error(i); if i=999 then exit; for var i:=1 to g-1 do for var j:=i+1 to g do if work[i].name>work[j].name then begin x:=work[i]; work[i]:=work[j]; work[j]:=x; end; writeln('Применение возрастающей сортировки по количеству товара'); writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*'); writeln('| Наименование товара | Фирма изготовитель | Срок хранения | Стоимость товара | Количество товара |'); writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*'); for var k:=1 to g do with work[k] do writeln('|', work[k].Name:40,'|',work[k].Fir:20,'|', work[k].Srok:15, '|', work[k].Stoim:20, '|', work[k].Kol:19, '|'); writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*'); close(users);//Закрываем файл. writeln('1 - Дальше. 2 - Выход'); readln(n); if n=2 then halt(1); end; begin repeat clrscr; writeln('Что делать?'); writeln('1 - Создавать базу данных.'); writeln('2 - Смотреть базу данных. '); writeln('3 - Сортировка по количеству товара.'); writeln('4 - Выход.'); readln(n); case n of 1:input; 2:OutputAllRec; 3:Sort; end; until (n=4); halt(1); end; Begin Readln; end. |
13.05.2018, 21:54 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Зачастую проблемы у людей очень похожие, обратите внимание на это как сохранить данные Пропал доступ к тому. Необходимо восстановить данные Необходимо найти принципиальное решение для следующей задачи... Как сохранить данные при переустановке windows xp Какие параметры необходимо ввести? |
13.05.2018, 22:18 | #2 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Полную отладку, если потребуется, сделаю завтра, а пока попробуйте начать с исправления явных ошибок:
1. Readln из второй снизу строки поставьте ПЕРЕД until (n=4); 2. halt(1), Begin, который в третьей снизу строке, и end;, который в четвертой снизу строке, уберите СОВСЕМ. |
13.05.2018, 22:34 | #3 (permalink) | |
Новичок
Регистрация: 13.05.2018
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Цитата:
|
|
14.05.2018, 20:00 | #4 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Вот, попробуйте погонять. Ошибок, конечно, море, вроде причесал.
Код:
Uses CRT; Const g=6; Type Tablica=record Name:string[20]; //Название товара Fir:string[20]; //Фирма изготовитель Srok:integer; //Срок хранения Stoim:integer; // Стоимость товара Kol_nom:integer; //Заданное количество товара Kol:integer; //Фактическое количество на складе end; var users:file of Tablica; // Сам файл work:array[1..g] of Tablica; //Массив записей для дальнейшей сортировки NewTabl:string[15]; // Имя файла i,j,k,n:integer; Procedure Name_file_for_tabl; // Задаем имя файла begin write('Введите имя файла данных '); Readln(NewTabl); end; Function Err:boolean; //Для ошибок связанных с отсутствием файла begin Assign(users,NewTabl); {$I-} //Проверка на то, что файл существует Reset(users); {$I+} if IOResult<>0 then begin Err:=TRUE; clrscr; end else begin Err:=FALSE; Close(users); end; end; Procedure input; // Происходит ввод файла begin assign(users, NewTabl); rewrite(users); //Создаем новый файл или перезаписываем for k:= 1 to g do begin with work[k] do begin write('Введите наименование товара: '); readln(Name); write('Введите фирму изготовителя: '); readln (Fir); write('Введите срок хранения: '); readln(Srok); write('Введите стоимость товара: '); readln(Stoim); write('Введите заданное количество товара: '); readln(Kol_nom); write('Введите фактическое количество товара: '); readln(Kol); writeln; end; write(users,work[k]); end; close(users); //Закрываем файл. end; Procedure Form_Work; //Чтение данных из файла в массив. begin if Err then begin Write('Файла с именем '+NewTabl+' на диске нет. Создать? Да - 1, Нет - 2 '); Readln(n); if n=1 then input; end else begin Reset(users); for k:=1 to g do Read(users,work[k]); Close(users); end; end; procedure OutputAllRec(b:byte); //Выводит записи // b=1 - все, b=2 - те, у которых фактическое количество не меньше заданного begin if Err then begin Write('Файла с именем '+NewTabl+' на диске нет. Создать? Да - 1, Нет - 2'); Readln(n); if n=1 then input; end else begin if b=1 then Form_Work; writeln('*---------------------*--------------------*-------*-------*--------*---------*'); writeln('| Наименование товара | Фирма изготовитель | Ср.хр.| Стоим.|Кол.ном.|Кол.факт.|'); writeln('*---------------------*--------------------*-------*-------*--------*---------*'); for k:=1 to g do //Вывод if b=2 then begin if work[k].Kol>=work[k].Kol_nom then writeln('|', work[k].Name:20,' |',work[k].Fir:20,'|', work[k].Srok:7, '|', work[k].Stoim:7, '|', work[k].Kol_nom:8, '|', work[k].Kol:9,'|'); end else writeln('|', work[k].Name:20,' |',work[k].Fir:20,'|', work[k].Srok:7, '|', work[k].Stoim:7, '|', work[k].Kol_nom:8, '|', work[k].Kol:9,'|'); writeln('*---------------------*--------------------*-------*-------*--------*---------*'); Readln; end; end; Procedure Sort; //Сортировка по возрастанию методом пузырька. var x:Tablica; begin if Not Err then begin Form_work; for i:=1 to g-1 do for j:=1 to g-i do if work[j].Kol>work[j+1].Kol then begin x:=work[j]; work[j]:=work[j+1]; work[j+1]:=x; end; writeln('Применение возрастающей сортировки по количеству товара'); OutputAllRec(2); end else begin Write('Файла с именем '+NewTabl+' на диске нет. Создать? Да - 1, Нет - 2 '); Readln(n); if n=1 then input; end; end; Begin clrscr; Name_file_for_tabl; // Спрашиваем имя Repeat clrscr; writeln('Что делать?'); writeln('1 - Создавать базу данных.'); writeln('2 - Смотреть базу данных. '); writeln('3 - Сортировка по количеству товара.'); writeln('4 - Выход.'); readln(n); case n of 1:input; 2:OutputAllRec(1); 3:Sort; end; Until (n=4); end. |
15.05.2018, 14:56 | #5 (permalink) |
Новичок
Регистрация: 13.05.2018
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Спасибо огромное. Но почему-то по запросу сортировки мне так же выводит саму бд как и по второму запросу. И есть один вопрос. Для чего вы разбили количество товара на заданное и фактическое и чем они отличаются? Заранее простите за то,что надоедаю.
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
15.05.2018, 19:31 | #6 (permalink) | |||
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
Цитата:
Цитата:
Ничего, пожалуйста, работа у нас такая. |
|||
16.05.2018, 11:49 | #9 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|