Специалист
Регистрация: 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.
Имена и пути к файлам поставьте, естественно, свои.
|