Правила форума
Прочтите прежде чем задавать вопрос!
Вот условие:
Даны 2 файла:
F1:шифр продукции; наименование
F2:№ склада; шифр продукции; количество
На одном складе может быть несколько видов продукции и продукция с одним шифром может встречаться в разных записях(т.е. в разных записях по файлу, на каждом складе в различных количествах?)
Нужно выдать ведомость для каждого склада:
[Шифр; наименование; количество(сумма)]
Значение номера склада печатать только в заголовке и подсчитать количество различных видов продукции на каждом складе.
Пример:
------№ склада 10 ----------
Шифр:56
Наименование: лампа паяльная
Количество:100
Шифр:99
Наименование: лампа керосиновая
Количество:100
------№ склада 19 ----------
Шифр:58
Наименование: лампа накаливания(220В, 150Вт)
Количество:107
Шифр:99
Наименование: лампа керосиновая
Количество:10
У меня проблемы с выводом ведомости(то наименование неправильно выводит, то суммирует не то?).
Код
uses crt;
type
table=record
ct:word;{Cipher in Table}
name:string[60];{naimenovanie}
end;
storage=record
number:byte;{nomer sklada}
cs:word;{Cipher in Storage}
amount:word;{kolichestvo}
end;
const
end_menu:boolean=false;
var
f1:file of table;
f2:file of storage;
work1:table;
work2:storage;
{/////////////////}
procedure ioe;
begin
textcolor(4);
writeln;
writeln('Ћ??ЃЉЂ ‚‚Ћ„Ђ! ЏЋЏђЋЃ“‰’… ‘ЌЋ‚Ђ!');
writeln;
writeln('ЌЂ†Њ?’… ‹ћЃ“ћ Љ‹Ђ‚??“...');
textcolor(10);
readkey;
end;
{/////////////////}
procedure inputintable;
var
c:byte;
aonr,i:word;
begin
clrscr;
reset(f1);
writeln('1-‚‚…‘’? …„?Ќ?—Ќ“ћ ‡ЂЏ?‘њ');
writeln('2-‚‚…‘’? Ќ…‘ЉЋ‹њЉЋ ‡ЂЏ?‘…‰');
write('>');
readln(c);
case c of
1:with work1 do
begin
seek(f1,filesize(f1));
write('??”ђ ЏђЋ„“Љ–??:');
readln(ct);
write('ЌЂ?Њ…ЌЋ‚ЂЌ?…:');
readln(name);
write(f1,work1);
end;
2:begin
seek(f1,filesize(f1));
write('‚‚…„?’… ЉЋ‹?—…‘’‚Ћ ЌЋ‚›• ‡ЂЏ?‘…‰:');
readln(aonr);
for i:=1 to aonr do
begin
clrscr;
writeln('‡ЂЏ?‘њ ь (ЌЋ‚Ђџ) ',i);
with work1 do
begin
write('??”ђ ЏђЋ„“Љ–??:');
readln(ct);
write('ЌЂ?Њ…ЌЋ‚ЂЌ?…:');
readln(name);
write(f1,work1);
end;
end;
end;
end;
close(f1);
end;
{////////////////////////////////////////////}
procedure inputinstorage;
var
c:byte;
aonr,i:word;
begin
clrscr;
reset(f2);
writeln('1-‚‚…‘’? …„?Ќ?—Ќ“ћ ‡ЂЏ?‘њ');
writeln('2-‚‚…‘’? Ќ…‘ЉЋ‹њЉЋ ‡ЂЏ?‘…‰');
write('>');
readln(c);
case c of
1:with work2 do
begin
seek(f2,filesize(f2));
write('ь ‘Љ‹Ђ„Ђ:');
readln(number);
write('??”ђ ЏђЋ„“Љ–??:');
readln(cs);
write('ЉЋ‹?—…‘’‚Ћ:');
readln(amount);
write(f2,work2);
end;
2:begin
seek(f2,filesize(f2));
write('‚‚…„?’… ЉЋ‹?—…‘’‚Ћ ЌЋ‚›• ‡ЂЏ?‘…‰:');
readln(aonr);
for i:=1 to aonr do
begin
clrscr;
writeln('‡ЂЏ?‘њ ь (ЌЋ‚Ђџ)',i);
with work2 do
begin
write('ь ‘Љ‹Ђ„Ђ:');
readln(number);
write('??”ђ ЏђЋ„“Љ–??:');
readln(cs);
write('ЉЋ‹?—…‘’‚Ћ:');
readln(amount);
write(f2,work2);
end;
end;
end;
end;
close(f2);
end;
{/////////////////}
procedure bordereau;
var
i,j,k,l,m,fnumber,lnumber,fct,lct:word;
sum:longint;
cstring:string[60];
cond:boolean;
begin{1}
clrscr;
writeln('---------------------------BEDOMOCTb---------------------------------');
reset(f1);
reset(f2);
{vychisljaem nomera zanesennyh v basu skladov}
fnumber:=65535;{first storage}
lnumber:=0; {last storage}
for i:=1 to filesize(f2) do
begin{2}
read(f2,work2);
if work2.number<fnumber then fnumber:=work2.number;
if work2.number>lnumber then lnumber:=work2.number;
end;{2}
{vychisljaem shifry zanesennyh v basu tovarov}
fct:=65535;{first ciphertable}
lct:=0; {last ciphertable}
for i:=1 to filesize(f1) do
begin{3}
read(f1,work1);
if work1.ct<fct then fct:=work1.ct;
if work1.ct>lct then lct:=work1.ct;
end;{3}
{!}
{dalee nachalis' problemy :))}
seek(f1,0);
seek(f2,0);
sum:=0;
for i:=fnumber to lnumber do
begin{4}
for j:=fct to lct do
begin{5}
read(f2,work2);
if ((work2.number=i) and (work2.cs=j)) then
begin{6}
seek(f2,0);
for k:=1 to filesize(f2) do
begin{7}
read(f2,work2);
if ((work2.number=i) and (work2.cs=j)) then sum:=sum+work2.amount;
end;{7}
for l:=1 to filesize(f1) do
begin{8}
read(f1,work1);
if work1.ct=j then
begin{9}
cstring:=work1.name;{cstring-CipherString}
break;
end;{9}
end;{8}
end;{6}
writeln('storage # ',i);
writeln('cipher: ',j);
writeln('name: ',cstring);
writeln('amount: ',sum);
writeln('--------------------------');
seek(f1,0);
seek(f2,0);
sum:=0;
end{5}
end;{4}
readkey;
end;{1}
{/////////////////}
procedure menu;
var
code:char;
pstn,c:integer;
cnd:boolean;
begin{!}
cnd:=false;
while cnd<>true do
begin{while}
clrscr;
writeln('і=============KOHTOPA==============і');
writeln('і1-‚Ќ…‘…Ќ?… „ЂЌЌ›• ‚ ЃЂ‡“ "table" і');
writeln('і2-‚Ќ…‘…Ќ?… „ЂЌЌ›• ‚ ЃЂ‡“ "storage"і');
writeln('і3-‚›„Ђ’њ ‚…„ЋЊЋ‘’њ і');
writeln('і4-‚›•Ћ„ і');
write ('ЉЋ„ ЋЏ…ђЂ–??:');
readln(code);
val(code,c,pstn);
if pstn=0 then
begin
case c of
1:inputintable;
2:inputinstorage;
3:bordereau;
4:end_menu:=true;
end;
cnd:=true;
end
else ioe;
end;{while}
end;{!}
{///////////////////////}
{/////main_program//////}
begin
clrscr;
{\\\\\\\\\\\\\\\\\\\\}
assign(f1,'table.dat');
{$I-}
reset(f1);
{$I+}
if ioresult<>0 then
begin
textcolor(4);
writeln('”Ђ‰‹ "table.dat" Ќ… ЌЂ‰„…Ќ. Ѓ“„…’ ‘Ћ‡„ЂЌ ЌЋ‚›‰ ”Ђ‰‹');
readkey;
rewrite(f1);
end;
{\\\\\\\\\\\\\\\\\\\\}
assign(f2,'storage.dat');
{$I-}
reset(f2);
{$I+}
if ioresult<>0 then
begin
textcolor(4);
writeln('”Ђ‰‹ "storage.dat" Ќ… ЌЂ‰„…Ќ. Ѓ“„…’ ‘Ћ‡„ЂЌ ЌЋ‚›‰ ”Ђ‰‹');
readkey;
rewrite(f2);
end;
close(f1);
close(f2);
textcolor(10);
{/////////////////////}
repeat menu until end_menu;
end.
Сообщение отредактировано: choodo -
