Показать сообщение отдельно
Старый 25.09.2016, 21:15   #4 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

В общем, так, сударь.
Сотворил я из изящной и красивой программки какого-то чудовищного монстра, и при том не знаю, то ли это, что Вам надо. Но, поскольку убил на это почти целый день, переделывать уже не буду. Уж не взыщите: чем богаты.
Модуль:
Код:
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.
Имена и пути к файлам поставьте, естественно, свои.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

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