Показать сообщение отдельно
Старый 13.05.2018, 21:54   #1 (permalink)
SendiH
Новичок
 
Регистрация: 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.
Не компилируется и выдаёт ошибку Встречено '.', а ожидалось ';' для последнего end. Если добавить begin end. то всё компилируется но не выполняется, а просто закрывается. Помогите найти ошибки. Я новичок в паскале. Пользуюсь если что Pascal ABC.net.
SendiH вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070