Приложения
Листинги программы
program mm;
uses crt;
type
sklad=record
name:string;{Название товара}
kol:integer;{Количество}
zen:integer;{Цена}
end;
const
norm=$17;{цвет невыделенного пункта}
sel=$70; {цвет выделенного пункта}
n=7;{количество пунктов в меню}
var
menu:array[1..n] of string[30]; {название пунктов меню}
punkt:integer;{номер выделенного пункта}
ch:char;{введенный символ}
mass:array[1..100]of sklad;
knt:byte;{количество наименований товаров}
poisk,open:byte;{флажок}
buf:sklad;
newt:sklad;{переменная имеющая тип записи}
ff:file of sklad;
x,y:integer;{координаты первой строки меню}
procedure Menutoscr;{вывод меню на экран}
var i:integer;
begin
clrscr;
for i:=1 to n do
begin
gotoxy(x,y+i-1);
write(menu[i]);
end;
{textattr-предопределенная переменная,отвечающая за цвет фона
и символов}
textattr:=sel;{цветом выделенного пункта}
gotoxy(x,y+punkt-1);
write(menu[punkt]); {выделим строку меню}
textattr:=norm;
end;
procedure newtov;{ввод нового товара}
begin
clrscr;
writeln('<<<Новое поступление товара>>>');
writeln('Название---:');
writeln('Количество-: (шт)');
writeln('Цена за шт-: (руб)');
writeln('Подтверждение (д/н):');
gotoxy(13,2);readln(newt.name);
gotoxy(13,3);readln(newt.kol);
gotoxy(13,4);readln(newt.zen);
gotoxy(21,5);readln(ch);
end;
procedure openfile;{открытие файла}
var i:byte;
begin
write('Создать новый список или использовать старый (д/н)');
readln(ch);
i:=1;
if ch='д' then
begin
rewrite(ff);
open:=0;
end
else
begin
reset(ff);
open:=1;
repeat
read(ff,buf);
mass[i]:=buf;
i:=i+1;
until eof(ff);
end;
knt:=i-1;
end;
procedure spisok;
var i:byte;
begin
writeln('Наименование количество в шт цена за шт в руб');
for i:=1 to knt do
begin
gotoxy(1,1+i);write(mass[i].name);
gotoxy(25,1+i);write(mass[i].kol);
gotoxy(50,1+i);write(mass[i].zen);
end;
end;
procedure search;
var i:byte;name1:string[30];
begin
poisk:=0;
write('Введите название товара-');readln(name1);
for i:=1 to knt do
if mass[i].name=name1 then
begin
writeln('Наименование количество в шт цена за шт в руб');
gotoxy(1,1+i);write(mass[i].name);
gotoxy(25,1+i);write(mass[i].kol);
gotoxy(50,1+i);write(mass[i].zen);
poisk:=1;
end;
end;
procedure deletetov;{удаление товара}
var i:byte;name1:string[30];
begin
poisk:=0;
write('Введите название товара-');readln(name1);
rewrite(ff);
for i:=1 to knt do
if mass[i].name=name1 then
begin
write('Товар найден! Удалить его из списка (д/н)-');readln(ch);
if ch<>'д' then
begin
writeln('Удаление отменено!');
write(ff,mass[i]);
end
else writeln('Элемент удалён!');
poisk:=1;
end
else write(ff,mass[i]);
if poisk=1 then begin
reset(ff);
open:=1;
i:=1;
repeat
read(ff,buf);
mass[i]:=buf;
i:=i+1;
until eof(ff);
knt:=i-1;
end;
end;
procedure sortirovka;
var i,f:byte;
begin
repeat
f:=0;
for i:=1 to knt do
begin
if (mass[i].name>mass[i+1].name) and (i<=knt-1) then
begin
buf:=mass[i];
mass[i]:=mass[i+1];
mass[i+1]:=buf;
f:=1;
end;
end;
until f=0;
rewrite(ff);
for i:=1 to knt do
begin
write(ff,mass[i]);
end;
writeln('Готово!');
end;
{основная программа}
Begin
clrscr;
menu[1]:='Список товаров на складе';
menu[2]:='Поиск товара';
menu[3]:='Новое поступление';
menu[4]:='Удаление из списка';
menu[5]:='Сортировать';
menu[6]:='Очистить список';
menu[7]:='Выход';
punkt:=1;x:=5;y:=5;textattr:=norm;
assign(ff,'sklad.dat');
open:=0;
openfile;
Menutoscr;{обращение к процедуре}
repeat
ch:=Readkey;
if ch=chr(0) then
begin
ch:=ReadKey;
case ch of
chr(80): {стрелка вниз}
if punkt<n then
begin
gotoxy(x,y+punkt-1);{курсор на место предыдущего пункта}
write(menu[punkt]);{печать предыдущего пункта}
punkt:=punkt+1;
textattr:=sel;{цвет для текущего пункта}
gotoxy(x,y+punkt-1);{курсор на текущий пункт}
write(menu[punkt]);{печать текущего пункта}
textattr:=norm; {цвет для пункта который будет считаться при сле-
дующем перемещении курсора предыдущим}
end;
chr(72):{стрелка вверх}
if (punkt<=n) and (punkt<>1) then
begin
gotoxy(x,y+punkt-1);
write(menu[punkt]);
punkt:=punkt-1;
textattr:=sel;
gotoxy(x,y+punkt-1);
write(menu[punkt]);
textattr:=norm;
end;
end; {case of}
end
else
if ch=chr(13) then {нажата клавиша <Enter>}
begin
case punkt of
1:
begin
clrscr;
if open=0 then writeln('Склад пуст!')
else spisok;
readln;
end;
2:
begin
clrscr;
if open=0 then
begin
writeln('Склад пуст!');
end
else
begin
search;
if poisk=0 then writeln('Товар не найден!');
end;
readln;
end;
3:
begin
clrscr;
repeat
newtov;
if ch='д' then
begin
mass[knt+1]:=newt;
knt:=knt+1;
write(ff,newt);
end;
write('Нажмите <Enter> для продолжения или любую клавишу для выхода в меню');
ch:=readkey;
until (ch=chr(27)) or (ch<>chr(13));
open:=1;
end;
4:begin
clrscr;
if open=0 then
begin
writeln('Склад пуст!');
end
else
begin
deletetov;
if poisk=0 then writeln('Товар не найден!');
end;
readln;
end;
5:begin
clrscr;
if open=0 then
begin
writeln('Склад пуст!');
end
else sortirovka;
readln;
end;
6:begin
clrscr;
if open=0 then
begin
writeln('Склад пуст!');
readln;
end
else openfile;
end;
7:ch:=chr(27); {выход}
end; {case of}
Menutoscr;
end;
until ch=chr(27);{27код <Esc>}
close(ff);
End.