Используемые процедуры для решения поставленной задачи:

1.4 Промежуточные данные

program sklading; // программа склад выполнил студент группы ивт13 ачилов александр

uses crt;

type

dat=record;

mons :1..12;

day:1..31;

year:2000..2015;

end;

baz=record

name:string[15];

Datin: dat;

dateforend: integer;

Datend: dat;

edizm:string[4];

mass:real;

ypack:string[8];

kolvo:integer;

holod:boolean;

agrsost:string[8];

end;

var

perekl: boolean;

t: file of baz;

sklad: array [1..30] of baz;

zapis: baz;

i,m,d,k,l,dn,p:integer;

s,sr:real;

fl,fi,a:string;

c,h:char;

procedure Zapprint(a:string); // вывод на экран вызываемая процедура var

sost:string;

begin

if zapis.holod = true then sost:= 'морозильник' else sost:= 'холодильник';

write (,'|',zapis.name:15,'| ',zapis.datin.day:3,' ',zapis.datin.mons:3,' ',zapis.datin.year:4,' | ',zapis.kolvo:4,' |',zapis.datend.day:3,' ',zapis.datend.mons:3,' ',zapis.datend.year:4,' |',zapis.agrsost:8,' | ',sost,'|');

writeln;

end;

procedure Tabprint(a:string); // вывод на экран вызываемая процедура

begin

writeln('| Наименование |дата поступления| упаковок|дата окончания| тип | место |');

writeln('| товара | день месяц год |на складе|срока годности|продукта| хранения|');

writeln

end;

procedure rdate(a:string); // расчёт кон даты

begin

case zapis.datin.mons of

1: p:=0;

2: p:=31;

3: p:=59 ;

4: p:=90;

5: p:=120;

6: p:=151 ;

7: p:=181;

8: p:=212;

9: p:=243;

10: p:=273;

11: p:=304;

12: p:=334;

end; zapis.datend.year:=zapis.datin.year;

dn:=p+zapis.dateforend+zapis.datin.day;

case dn of

1..31: begin zapis.datend.mons :=1; zapis.datend.day:=dn; end;

32..59: begin zapis.datend.mons :=2; zapis.datend.day:=dn-31; end;

60..90: begin zapis.datend.mons :=3; zapis.datend.day:=dn-59; end;

91..120: begin zapis.datend.mons :=4; zapis.datend.day:=dn-90; end;

121..151:begin zapis.datend.mons :=5; zapis.datend.day:=dn-120; end;

152..181:begin zapis.datend.mons :=6; zapis.datend.day:=dn-151; end;

182..212:begin zapis.datend.mons :=7; zapis.datend.day:=dn-181; end;

213..243:begin zapis.datend.mons :=8; zapis.datend.day:=dn-212; end;

244..273:begin zapis.datend.mons :=9; zapis.datend.day:=dn-243; end;

274..304:begin zapis.datend.mons :=10; zapis.datend.day:=dn-273; end;

305..334:begin zapis.datend.mons :=11; zapis.datend.day:=dn-304; end;

335..365:begin zapis.datend.mons :=12; zapis.datend.day:=dn-334; end;

else

begin

dn:=dn-365;

zapis.datend.year:=zapis.datend.year+1;

case dn of

1..31: begin zapis.datend.mons :=1; zapis.datend.day:=dn; end;

32..59: begin zapis.datend.mons :=2; zapis.datend.day:=dn-31; end;

60..90: begin zapis.datend.mons :=3; zapis.datend.day:=dn-59; end;

91..120: begin zapis.datend.mons :=4; zapis.datend.day:=dn-90; end;

121..151:begin zapis.datend.mons :=5; zapis.datend.day:=dn-120; end;

152..181:begin zapis.datend.mons :=6; zapis.datend.day:=dn-151; end;

182..212:begin zapis.datend.mons :=7; zapis.datend.day:=dn-181; end;

213..243:begin zapis.datend.mons :=8; zapis.datend.day:=dn-212; end;

244..273:begin zapis.datend.mons :=9; zapis.datend.day:=dn-243; end;

274..304:begin zapis.datend.mons :=10; zapis.datend.day:=dn-273; end;

305..334:begin zapis.datend.mons :=11; zapis.datend.day:=dn-304; end;

335..365:begin zapis.datend.mons :=12; zapis.datend.day:=dn-334; end; end;

end;

end;

end;

procedure Vvod(a:string); // ввод данных

var

new:char;

begin

write('Наименование товара - ');

readln(zapis.name);

write('Дата поступления - день месяц год: ');

readln(zapis.datin.day,zapis.datin.mons,zapis.datin.year);

write('Срок годности (дни)- ');

readln(zapis.dateforend);

rdate(a); //расчет даты окончания срока годности

write('Единица измерения - ');

readln(zapis.edizm);

write('масса товара- ');

readln(zapis.mass);

write('Способ упаковки - ');

readln(zapis.ypack);

write('количество упаковок - ');

readln(zapis.kolvo);

write('темпратура хранения - до 2гр С - ввести 1, если от 2 до 18 гр С - 0 ');

readln(h);if upcase(h)='1' then zapis.holod:=true else zapis.holod:=false;

write('тип хранимого продукта - ');

readln(zapis.agrsost);

end;

procedure PRINT (a:string); // печать на экране

var

zapis: baz; begin

reset (t);

tabprint(a); //вывод таблицы

while not eof(t) do

begin

read (t,zapis);

Zapprint(a); //печать данных

end;

write('Выберите следующее действие - ');

readln(fl);

close(t);

end;

procedure ADDITEM(a:string); // добавление

var

new:char;

begin

reset(t);

seek (t,filesize(t));

repeat

Vvod(a);

write(t,zapis);

write('повторить ввод да - 1 / нет - 0');

readln(new);

if (upcase(new)='1') then perekl:=false else perekl:=true;

until perekl;

end;

procedure Change (a:string); // изменение записи

var

zapis: baz;

perekl: boolean; begin

reset (t);

writeln('выберите запись для изменения и нажмите С, для удаления - D, слудующая запись - N');

i:=0;

Tabprint(a); //вывод таблицы

repeat

begin

if eof(t) then begin perekl:=true;continue; end;

read (t,zapis);

Zapprint(a); //печать данных

read(fl[1]);

case fl[1] of

'C': begin Vvod(a); i:=i+1; sklad[i]:=zapis; perekl:=false; end;

'c': begin Vvod(a); i:=i+1; sklad[i]:=zapis; perekl:=false; end;

'N': begin i:=i+1; sklad[i]:=zapis; perekl:=false; end;

'n': begin i:=i+1; sklad[i]:=zapis; perekl:=false; end;

'D': continue;

'd': continue;

end;

end;

until (perekl) or (not eof(t));

writeln;

rewrite(t);

for k:=1 to i do

begin

zapis:=sklad[k];

write(t,zapis);;

end;

close(t);

end;

procedure Find(a:string); // поиск в базе

var fi:string;

nam: string[15];

day1, mons1, year1, dateforend1, mass1 : integer;

holod1:boolean;

agrsost1:string[8];

begin

reset (t);

i:=0;

writeln(i);

perekl:=false;

repeat

begin

if eof(t) then begin perekl:=true;continue; end;

read (t,zapis);

i:=i+1;

sklad[i]:=zapis;

end;

until perekl;

writeln('поиск используются только прописные буквы');

writeln('по названию - n');

writeln('по дате поступления - p');

writeln('по условию хранения - h');

writeln('по сроку годности - g');

writeln('по остаток на складе - o');

writeln('по тип продукта - t');

readln(fi[1]);

case fi of

'n': begin write('введите наименование - ');readln (nam);Tabprint(a);

for k:=1 to i do

begin

if sklad[k].name=nam then begin zapis:=sklad[k];ch:=k; Zapprint(a);end;

end; end;

'p': begin write('введите дату поступления - '); readln(day1,mons1,year1);Tabprint(a);

for k:=1 to i do

begin

if (sklad[k].datin.day = day1) and (sklad[k].datin.mons = mons1) and (sklad[k].datin.year = year1) then begin zapis:=sklad[k];

ch:=k;

Zapprint(a); end;

end;

end;

'h': begin write('введите условия хранения - до 2гр С - ввести 1, если от 2 до 18 гр С - 0 - ');

readln(h);

Tabprint(a);

if upcase(h)='1' then holod1:=true else holod1:=false;

for k:=1 to i do

begin

if sklad[k].holod=holod1 then begin zapis:=sklad[k];ch:=k; Zapprint(a); end;

end; end;

'g': begin write('срок годности (дни) - '); readln(dateforend1); Tabprint(a);

for k:=1 to i do

begin

if sklad[k].dateforend=dateforend1 then

begin

zapis:=sklad[k];

ch:=k;

Zapprint(a);

end;

end;

end;

'o': begin write('остаток на складе (количество) - '); readln(kolvo1); Tabprint(a);

for k:=1 to i do

begin

if (sklad[k].kolvo=kolvo1) then begin

zapis:=sklad[k];

ch:=k;

Zapprint(a);

end;

end;

end;

't': begin write('тип продукта - '); readln(agrsost1); Tabprint(a);

for k:=1 to i do

begin

if (sklad[k].agrsost=agrsost1) then

begin

zapis:=sklad[k];

ch:=k;

Zapprint(a);

end;

end;

end;

end;

close(t);

write('Выберите следующее действие - ');

readln(fl);

end;

begin // код программы

a:='d:\kyrsSKLAD.dat';

assign (t,a);

repeat

writeln ('Выберите выполняемое действие');

writeln ('Создать файл базы\перезаписать существующий - R ');

writeln ('Вывод на экран - P ');

writeln ('Добавление данных в базу -Z ');

writeln ('Выбор изменение\удаление записи - C'); writeln ('Выход из программы - E ');

readln (fl);

if (upcase(fl[1])='R') or (upcase(fl[1])='r') then Rewrite(t);

if (upcase(fl[1])='P') or (upcase(fl[1])='p') then PRINT(a);

if (upcase(fl[1])='Z') or (upcase(fl[1])='z') then ADDITEM(a);

if (upcase(fl[1])='C') or (upcase(fl[1])='c') then Change(a);

clrscr;

until (upcase(fl[1])='E') or (upcase(fl[1])='e');

close(t);

end.

5. Описание контрольного примера