Технический форум - "Файлы", доработка программы с темой "Записи"

Технический форум (http://www.tehnari.ru/)

- Delphi, Kylix and Pascal (http://www.tehnari.ru/f43/)

"Файлы", доработка программы с темой "Записи"

Есть программа по такому заданию:
Описать запись с именем PRICE, содержащую следующие
поля:
-название товара;
-название магазина, в котором продается товар;
-стоимость товара в руб.
Написать программу, выполняющую следующие действия:
-ввод с клавиатуры данных в массив, состоящий из восьми элементов типа PRICE;
-вывод таблицы на экран;
-записи разместить в алфавитном порядке по названиям магазинов;
-вывод отсортированной таблицы на экран;
-вывод на экран информации о товарах, продающихся в магазине, название которого введено с клавиатуры;
-если такого магазина нет, выдать на дисплей соответствующее
сообщение.

Помогите пожалуйста основываясь на этой программе сдать следующее задание:
1. вызов запросов оформить в виде меню;
2. добавить пункты: сохранить таблицу в файле и прочитать
таблицу из файла. Типы файлов:
– типизированный файл из записей;
– типизированный файл из символов;
– текстовый файл;
3. запросы оформить в виде подпрограмм. Все объявления и
подпрограммы должны быть оформлены в виде модуля (модулей)

Код:

uses crt;

const n=8;

type price=record

           tov,mgz:string[20];

           stm:word;

           end;

var z:array[1..n] of price;

    x:price;

    i,j,k:byte;

    m:string[20];

begin

clrscr;

writeln('Введите данные о ',n,' товарах:');

for i:=1 to n do

with z[i] do

 begin

  writeln('Товар ',i);

  write(' Название товара: ');readln(tov);

  write(' Название магазина: ');readln(mgz);

  write(' Стоимость: ');readln(stm);

 end;

clrscr;

writeln('Исходный список товаров');

writeln('----------------------------------------------------------------');

writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

writeln('----------------------------------------------------------------');

for i:=1 to n do

writeln('|',z[i].tov:20,'|',z[i].mgz:20,'|',z[i].stm:20,'|');

writeln('----------------------------------------------------------------');

for i:=1 to n-1 do

for j:=i+1 to n do

if z[i].mgz>z[j].mgz then

 begin

  x:=z[i];

  z[i]:=z[j];

  z[j]:=x;

 end;

writeln('Список товаров по алфавиту названий магазинов');

writeln('----------------------------------------------------------------');

writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

writeln('----------------------------------------------------------------');

for i:=1 to n do

writeln('|',z[i].tov:20,'|',z[i].mgz:20,'|',z[i].stm:20,'|');

writeln('----------------------------------------------------------------');

{если высота экрана 25 символов, нужно 3 следующих строки, если 40, не нужно}

write('Нажмите любую клавишу для продолжения');

readkey;

clrscr;

write('Введите название магазина для поиска:');

readln(m);

writeln('Список товаров продающихся в магазине ',m);

writeln('----------------------------------------------------------------');

writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

writeln('----------------------------------------------------------------');

k:=0;

for i:=1 to n do

if z[i].mgz=m then

 begin

  k:=1;

  writeln('|',z[i].tov:20,'|',z[i].mgz:20,'|',z[i].stm:20,'|');

 end;

writeln('----------------------------------------------------------------');

if k=0 then writeln('Такого магазина нет!');

write('Нажмите любую клавишу для выхода');

readkey

end.

Цитата:

Сообщение от gaben134 (Сообщение 2417628)

Помогите пожалуйста основываясь на этой программе сдать следующее задание:
1. вызов запросов оформить в виде меню;
2. добавить пункты: сохранить таблицу в файле и прочитать таблицу из файла. Типы файлов:
– типизированный файл из записей;
– типизированный файл из символов;
– текстовый файл;
3. запросы оформить в виде подпрограмм. Все объявления и подпрограммы должны быть оформлены в виде модуля (модулей)

М-да... круто. И, как говорится, "маразм крепчал"...
1. "В виде меню" - это как? Чтобы программа обрабатывала мышиные клики? Нет, не возьмусь.
2. Всю дорогу считал, что тип File of Char ("типизированный файл из символов") и Text ("текстовый файл") - это полные синонимы. Ан вот поди ж ты...
3. Модули? Можно, конечно, и модули. Правда, это "из пушек по воробьям", но если надо...

Ладно, подумаю, что тут можно сделать...

Понимаете, что это задание придумал не я, а препод в универе, и ему глубоко пофиг на нюансы...

В общем, так, сударь.
Сотворил я из изящной и красивой программки какого-то чудовищного монстра, и при том не знаю, то ли это, что Вам надо. Но, поскольку убил на это почти целый день, переделывать уже не буду. Уж не взыщите: чем богаты.
Модуль:

Код:

Unit My_Unit;



Interface



Const

 N=8;



Type

 Price=record

        tov,mgz:string[20];

        stm:word;

       end;

 Ar_Pr=Array[1..N] of Price;

 Ar_St=Array[1..N] of String[20];

 Ar_Wd=Array[1..N] of Word;



Procedure Wrt_F_Rec(Nm_Rec:string; WFR:Ar_Pr);

Procedure Wrt_F_Txt(Nm_Txt:string; WFT1,WFT2:Ar_St; WFT3:Ar_Wd);

Procedure Out_F_Rec(Nm_Rec:string; var OFR:Ar_Pr);

Procedure Out_F_Txt(Nm_Txt:string; var OFT1:Ar_St; var OFT2:Ar_St; var OFT3:Ar_Wd);

Procedure Order_Rec(Nm_Rec:string);

Procedure Order_Txt(Nm_Txt:string);

Procedure Search_Mag_Rec(Nm_Rec:string; Mg:string[20]; var SMR:Ar_Pr; var SN:Byte);

Procedure Search_Mag_Txt(Nm_Txt:string; Mg:string[20]; var SMT1:Ar_St; var SMT2:Ar_St; var SMT3:Ar_Wd; var SN:byte);



Implementation



Procedure Wrt_F_Rec(Nm_Rec:string; WFR:Ar_Pr);

var

 F:File of Price;

 i:Byte;

begin

 Assign(F, Nm_Rec);

 Rewrite(F);

 for i:=1 to N do write(F,WFR[i]);

 Close(F);

end;



Procedure Wrt_F_Txt(Nm_Txt:string; WFT1,WFT2:Ar_St; WFT3:Ar_Wd);

var

 F:Text;

 i:Byte;

begin

 Assign(F, Nm_Txt);

 Rewrite(F);

 for i:=1 to N do

  writeln(F,'|',WFT1[i]:20,'|',WFT2[i]:20,'|',WFT3[i]:20,'|');

 Close(F);

end;



Procedure Out_F_Rec(Nm_Rec:string; var OFR:Ar_Pr);

var

 F:File of Price;

 i:Byte;

begin

 Assign(F, Nm_Rec);

 Reset(F);

 for i:=1 to N do read(F,OFR[i]);

 Close(F);

end;



Procedure Out_F_Txt(Nm_Txt:string; var OFT1:Ar_St; var OFT2:Ar_St; var OFT3:Ar_Wd);

var

 F:Text;

 i:Byte;

 C:Char;

 S:String[20];

 Code:Word;

begin

 Assign(F, Nm_Txt);

 Reset(F);

 for i:=1 to N do

  begin

   Read(F,C);

   Read(F,OFT1[i]);

   Read(F,C);

   Read(F,OFT2[i]);

   Read(F,C);

   Readln(F,S);

   Val(S,OFT3[i],Code);

  end;

 Close(F);

end;



Procedure Order_Rec(Nm_Rec:string);

var

 F:File of Price;

 G:Ar_Pr;

 i,j:Byte;

 D:Price;

begin

 Assign(F,Nm_Rec);

 Reset(F);

 for i:=1 to N do read(F,G[i]);

 Close(F);

 for i:=1 to N-1 do

  for j:=1 to N-i do

   if G[j].mgz>G[j+1].mgz then

    begin

     D:=G[j];

     G[j]:=G[j+1];

     G[j+1]:=D;

    end;

 Rewrite(F);

 for i:=1 to N do write(F,G[i]);

 Close(F);

end;



Procedure Order_Txt(Nm_Txt:string);

var

 G1,G2:Ar_St;

 G3:Ar_Wd;

 i,j:Byte;

 D1,D2:String[20];

 D3:Word;

begin

 Out_F_Txt(Nm_Txt,G1,G2,G3);

 for i:=1 to N-1 do

  for j:=1 to N-i do

   if G2[j]>G2[j+1] then

    begin

     D1:=G1[j];

     G1[j]:=G1[j+1];

     G1[j+1]:=D1;

     D2:=G2[j];

     G2[j]:=G2[j+1];

     G2[j+1]:=D2;

     D3:=G3[j];

     G3[j]:=G3[j+1];

     G3[j+1]:=D3;

    end;

 Wrt_F_Txt(Nm_Txt,G1,G2,G3);

end;



Procedure Search_Mag_Rec(Nm_Rec:string; Mg:string[20]; var SMR:Ar_Pr; var SN:Byte);

var

 i:byte;

 SR:Ar_Pr;

begin

 SN:=0;

 Out_F_Rec(Nm_Rec,SR);

 for i:=1 to N do

  if SR[i].mgz=Mg then

   begin

    Inc(SN);

    SMR[SN]:=SR[i];

   end;

 end;



Procedure Search_Mag_Txt(Nm_Txt:string; Mg:string[20]; var SMT1:Ar_St; var SMT2:Ar_St; var SMT3:Ar_Wd; var SN:byte);

var

 i:byte;

 ST1,ST2:Ar_St;

 ST3:Ar_Wd;

 MgT:String[20];

begin

 SN:=0;

 MgT:='';

 for i:=1 to (20-Length(Mg)) do MgT:=MgT+' ';

 MgT:=MgT+Mg;

 Out_F_Txt(Nm_Txt,ST1,ST2,ST3);

 for i:=1 to N do

  if ST2[i]=MgT then

   begin

    INC(Sn);

    SMT1[Sn]:=St1[i];

    SMT2[Sn]:=St2[i];

    SMT3[Sn]:=St3[i];

   end;

end;



End.

Программа:

Код:

Uses CRT,My_Unit;



Var

 z:Ar_Pr;

 tv,mz:Ar_St;

 sm:Ar_Wd;

 q,i,K:byte;

 m:string[20];

 File_Name_Rec,File_Name_Txt:String;



Begin

 File_Name_Rec:='D:\Goods.rec';

 File_Name_Txt:='D:\Goods.txt';

 clrscr;

 writeln('Введите данные о ',N,' товарах:');

  for i:=1 to n do

   with z[i] do

    begin

     writeln('Товар ',i);

     write(' Название товара: ');readln(tov);

     tv[i]:=tov;

     write(' Название магазина: ');readln(mgz);

     mz[i]:=mgz;

     write(' Стоимость: ');readln(stm);

     sm[i]:=stm;

    end;

 Wrt_F_Rec(File_Name_Rec,z);

 Wrt_F_Txt(File_Name_Txt,tv,mz,sm);

 clrscr;

 writeln('Исходный список товаров по данным из файла записей:');

 writeln('----------------------------------------------------------------');

 writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

 writeln('----------------------------------------------------------------');

 Out_F_Rec(File_Name_Rec,z);

 for i:=1 to n do

  writeln('|',z[i].tov:20,'|',z[i].mgz:20,'|',z[i].stm:20,'|');

 writeln('----------------------------------------------------------------');

 writeln('Для продолжения нажмите любую клавишу');

 ReadKey;

 clrscr;

 writeln('Исходный список товаров по данным из текстового файла:');

 writeln('----------------------------------------------------------------');

 writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

 writeln('----------------------------------------------------------------');

 Out_F_Txt(File_Name_Txt,tv,mz,sm);

 for i:=1 to n do

  writeln('|',tv[i]:20,'|',mz[i]:20,'|',sm[i]:20,'|');

 writeln('----------------------------------------------------------------');

 writeln('Для продолжения нажмите любую клавишу');

 ReadKey;

 Order_Rec(File_Name_Rec);

 Order_Txt(File_Name_Txt);

 clrscr;

 writeln('Упорядоченный по магазинам список товаров по данным из файла записей:');

 writeln('----------------------------------------------------------------');

 writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

 writeln('----------------------------------------------------------------');

 Out_F_Rec(File_Name_Rec,z);

 for i:=1 to n do

  writeln('|',z[i].tov:20,'|',z[i].mgz:20,'|',z[i].stm:20,'|');

 writeln('----------------------------------------------------------------');

 writeln('Для продолжения нажмите любую клавишу');

 ReadKey;

 clrscr;

 writeln('Упорядоченный по магазинам список товаров по данным из текстового файла:');

 writeln('----------------------------------------------------------------');

 writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

 writeln('----------------------------------------------------------------');

 Out_F_Txt(File_Name_Txt,tv,mz,sm);

 for i:=1 to n do

  writeln('|',tv[i]:20,'|',mz[i]:20,'|',sm[i]:20,'|');

 writeln('----------------------------------------------------------------');

 writeln('Для продолжения нажмите любую клавишу');

 ReadKey;

 ClrScr;

 write('Введите название магазина для поиска: ');

 readln(m);

 writeln('Список товаров, продающихся в магазине ',m,' по файлу записей:');

 Search_Mag_Rec(File_Name_Rec,m,z,K);

 if K=0 then writeln('Такого магазина нет!') else

 begin

  writeln('----------------------------------------------------------------');

  writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

  writeln('----------------------------------------------------------------');

  for i:=1 to K do

   writeln('|',z[i].tov:20,'|',z[i].mgz:20,'|',z[i].stm:20,'|');

  writeln('----------------------------------------------------------------');

 end;

 writeln('Для продолжения нажмите любую клавишу');

 ReadKey;

 ClrScr;

 writeln('Список товаров, продающихся в магазине ',m,' по текстовому файлу:');

 Search_Mag_Txt(File_Name_Txt,m,tv,mz,sm,K);

 if K=0 then writeln('Такого магазина нет!') else

 begin

  writeln('----------------------------------------------------------------');

  writeln('|   Название товара  |  Название магазина |  Стоимость товара  |');

  writeln('----------------------------------------------------------------');

  for i:=1 to K do

   writeln('|',tv[i]:20,'|',mz[i]:20,'|',sm[i]:20,'|');

  writeln('----------------------------------------------------------------');

 end;

 writeln;

 write('Нажмите любую клавишу для выхода');

 Readkey

End.

Имена и пути к файлам поставьте, естественно, свои.