Лабораторная работа №8-10
Постановка задачи: Создать программу-базу данных по предметной области предприятие ( Пользователи Администратор ( просмотр, редактирование, удаление, архив( переход), изменение пароля, смена пользователя), Бухгалтер ( расчет зарплаты, расчет премии, коммунальные услуги, просмотр информации, смена пользователя), Кассир ( просмотр товаров, фильтр товаров, продажа, история продаж, смена пользователя), Кадры ( информация о сотруднике, добавление/удаление сотрудника, редактирование, штатное расписание( переход), архив( переход), смена пользователя), Склад просмотр товаров, добавление товаров, закупка товаров, изменение цены, удаление/восстановление товара, просмотр удаленных товаров( переход), смена пользователя), работа с фаилами ( товары, пользователи, штатное расписание, кадры, доход), применение графичеких примитивов (диаграмма)).
Тест:
Входные данные: |
Выходные данные: |
Нет |
Нет |
Листинг программы:
Модуль главный
uses crt, UAdmin, USklad, UKadri, Ubuh, UKassa, Udop, graphabc;
type
polzovatel=record
login:string[20];
password:string[30];
prava:byte;
blokirovka:byte;
posled_vhod:string[10];
end;
var
y,i2,s:integer;
user:polzovatel;
m:array[1..7] of string[25];
i,j:integer;
d:char;
fl:boolean;
k,color:integer;
procedure menu;
var ch:char;
begin
repeat
clrscr;
gotoxy(25,3);
writeln('Выбор для администратора');
gotoxy(1,6);
writeln('1. Модуль Администратора');
writeln('2. Модуль Бухгалтера');
writeln('3. Модуль Кассира');
writeln('4. Модуль Кадров');
writeln('5. Модуль Кладовщика');
writeln('6. Выход');
clrbuf; ch:=readkey;
case ch of
#49: indexAdmin;
#50: indexBuh;
#51: indexKassa;
#52: indexKadri;
#53: indexSklad;
#54: break;
end;
until (ch=#49)or(ch=#50)or(ch=#51)or(ch=#52)or(ch=#53);
end;
function signup:boolean;
var fp:file of polzovatel;
flag:boolean;
login:string[20];
ch:char;
k:integer;
key:char;
pass_ar:array[1..10] of char;
pass_count:byte;
password:string;
begin
k:=0;
flag:=false;
repeat
clrscr; gotoxy(25,3); writeln('Вход в систему');
gotoxy(1,6); writeln('Для продолжения нажмите [Enter]');
writeln('Для выхода из системы нажмите [ESC]');
clrbuf; ch:=readkey;
if ch=#27 then break;
clrscr;
gotoxy(25,3); writeln('Вход в систему');
gotoxy(1,6);
write('Логин: '); readln(login);
write('Пароль: ');
pass_count:=0; password:='';
repeat
inc(pass_count);
clrbuf;
key:=readkey;
if key<>#13 then
begin
pass_ar[pass_count]:=key;
write('*');
password:=password+pass_ar[pass_count];
end;
until key=chr(13);
assign(fp,'polzovatel.pk229');
reset(fp);
while ((not(EOF(fp)))and(flag<>true)) do
begin
read(fp,user);
if ((user.login=login)and(user.password=password)) then flag:=true;
end;
close(fp); gotoxy(15,10);
if flag then writeln('Успешный вход в систему')
else writeln('Ошибка входа.');
clrbuf; repeat until keypressed;
k:=k+1;
if k=3 then break;
until flag;
if k=3 then writeln('Вы израсходывали количество попыток входа');
if flag then
begin
writeln('Меню');
case user.prava of
1: menu;
2: indexBuh;
3: indexKassa;
4: indexKadri;
5: indexSklad;
end;
signup:=true;
end
else signup:=false;
end;
procedure a1(j:integer;s:integer);
begin
setpixel(j,y,s);
setpixel(j,y+1,s);
setpixel(j,y+2,s);
setpixel(j,y+3,s);
setpixel(j,y+4,s);
setpixel(j,y+5,s);
setpixel(j,y+6,s);
setpixel(j,y+7,s);
setpixel(j,y+8,s);
setpixel(j,y+9,s);
setpixel(j,y+10,s);
setpixel(j,y+11,s);
setpixel(j,y+12,s);
end;
begin
gotoxy(33,2);
write('Загрузочка');
s:=70250250;
j:=200;
y:=40;
for i2:=1 to 200 do
begin
sleep(5);
j:=j+1;
s:=s - 150;
a1(j,s);
end;
repeat
fl:=signup;
until not(fl);
writeln;
writeln('Программа завершена'); writeln('Для закрытия окна нажмите [Esc]');
end.
Модуль админ
unit UAdmin;
interface
uses crt, Udop, UArhivAdmin;
type
polzovatel=record
login:string[20];
password:string[30];
prava:byte;
blokirovka:byte;
posled_vhod:string[10];
end;
var
user:polzovatel;
m:array[1..7] of string[25];
i,j:integer;
d:char;
procedure menu;
procedure prosmotr;
procedure registracia;
procedure udalenie;
procedure smena;
procedure indexAdmin;
implementation
procedure menu;
begin
gotoxy(25,3);
writeln('Модуль администратора');
gotoxy(1,6);
m[1]:='Просмотр пользователей';
m[2]:='Регистрация пользователей';
m[3]:='Удаление пользователей';
m[4]:='Архив';
m[5]:='Смена пароля';
m[6]:='Выход';
for i:=1 to 6 do
if i=j then
writeln('>> ', m[i])
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure prosmotr;
var fp: file of polzovatel;
i:integer;
begin
writeln('Имя пользователя':25,'Пароль':15,'Права':10);
for i:=1 to 50 do write('-');
writeln;
assign(fp,'polzovatel.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
writeln(user.login:20,user.password:20, user.prava:7);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
procedure registracia;
var fp: file of polzovatel;
flag:boolean;
newlogin:string[20];
begin
repeat
flag:=false;
writeln; writeln;
write('Введите логин -> ');read(newlogin);
assign(fp,'polzovatel.pk229');
reset(fp);
while not(EOF(fp)) and not(flag) do
begin
read(fp,user);
if user.login=newlogin then flag:=true;
end;
close(fp);
if flag then writeln('Такой пользователь уже существует');
until not(flag);
user.login:=newlogin;
write('Введите пароль -> '); readln(user.password);
writeln('Роль: 1 - Администратор / 2 - Бухгалтер / 3 - Кассир / 4 - Кадровик / 5 - Кладовщик'); readln(user.prava);
assign(fp,'polzovatel.pk229');
reset(fp);
seek(fp,fileSize(fp));
write(fp,user);
close(fp);
end;
procedure udalenie;
var poisk:string[20];
fi,fo: file of polzovatel;
mass: array[1..10] of polzovatel;
i,k:integer;
begin
write('Ввкдите имя пользователя: '); readln(poisk);
assign(fi,'polzovatel.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if not(user.login=poisk)
then begin
mass[i]:=user;
inc(i);
end
else begin
assign(fo,'arhiv.pk229');
reset(fo);
seek(fo,FileSize(fo));
write(fo,user);
close(fo);
end;
end;
close(fi);
rewrite(fi);
for k:=1 to i-1 do
write(fi,mass[k]);
close(fi);
end;
procedure smena;
var poisk,newpass:string[30];
fi: file of polzovatel;
i:integer;
begin
write('Введите имя пользователя: '); readln(poisk);
assign(fi,'polzovatel.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if (user.login=poisk)
then begin
write('Введите новый пароль: ');
readln(newpass);
user.password:=newpass;
seek(fi,i-1);
write(fi,user);
break;
end;
inc(i);
end;
close(fi);
end;
procedure indexAdmin;
begin
j:=1;
repeat
clrscr;
menu;
clrbuf;
d:=readkey;
if d=#0 then
begin
d:=readkey;
if d=#72 then
begin
if j=1 then j:=6
else j:=j-1;
end;
if d=#80 then
begin
if j=6 then j:=1
else j:=j+1;
end;
end
else
begin
if d=#13 then
begin
case j of
1: prosmotr;
2: registracia;
3: udalenie;
4: indexArhiv;
5: smena;
6: break;
end;
end;
end;
until 2+2=5;
end;
end.
Модуль архив(админ)
unit UArhivAdmin;
interface
uses crt;
type
polzovatel=record
login:string[20];
password:string[30];
prava:byte;
blokirovka:byte;
posled_vhod:string[10];
end;
var
user:polzovatel;
m:array[1..7] of string[42];
i,j:integer;
d:char;
implementation
procedure clrbuf;
var ch:char;
begin
while keypressed do ch:=readkey;
end;
procedure menu;
begin
gotoxy(25,3);
writeln('Модуль Архива');
gotoxy(1,6);
m[1]:='Просмотр удаленных пользователей';
m[2]:='Физическое удаление пользователей';
m[3]:='Восстановление удаленных пользователей';
m[4]:='Выход';
for i:=1 to 4 do
if i=j then
writeln('>> ', m[i])
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure prosmotr;
var fp: file of polzovatel;
i:integer;
begin
writeln('Имя пользователя':25,'Пароль':15,'Права':10);
for i:=1 to 50 do write('-');
writeln;
assign(fp,'arhiv.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
writeln(user.login:20,user.password:20, user.prava:7);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
procedure udalenie;
var poisk:string[20];
fi: file of polzovatel;
mass: array[1..10] of polzovatel;
i,k:integer;
begin
write('Введите имя пользователя: '); readln(poisk);
assign(fi,'arhiv.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if not(user.login=poisk)
then begin
mass[i]:=user;
inc(i);
end
end;
close(fi);
rewrite(fi);
for k:=1 to i-1 do
write(fi,mass[k]);
close(fi);
end;
procedure vosstanovlenie;
var poisk:string[20];
fi,fo: file of polzovatel;
mass: array[1..10] of polzovatel;
i,k:integer;
begin
write('Ввкдите имя пользователя: '); readln(poisk);
assign(fi,'arhiv.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if not(user.login=poisk)
then begin
mass[i]:=user;
inc(i);
end
else begin
assign(fo,'polzovatel.pk229');
reset(fo);
k:=FileSize(fo);
seek(fo,k);
write(fo,user);
close(fo);
end;
end;
close(fi);
rewrite(fi);
for k:=1 to i-1 do
write(fi,mass[k]);
close(fi);
end;
procedure indexArhiv;
begin
j:=1;
repeat
clrscr;
menu;
clrbuf;
d:=readkey;
if d=#0 then
begin
d:=readkey;
if d=#72 then
begin
if j=0 then
j:=6
else
j:=j-1;
end;
if d=#80 then
begin
if j=6 then
j:=1
else
j:=j+1;
end;
end
else
begin
if d=#13 then
begin
case j of
1: prosmotr;
2: udalenie;
3: vosstanovlenie;
4: break;
end;
end;
end;
until 2+2=5;
end;
end.
Модуль бугалтерия
unit UBuh;
interface
uses crt, UKadri, URaspis, Udop,graphabc;
type
zarp=record
FIO:string[30];
doljnost:string[20];
dengi:real;
end;
var
m:array[1..7] of string[25];
i,j:integer;
d:char;
implementation
procedure BUmenu;
begin
gotoxy(25,3);
writeln('Модуль бухгалтерии');
gotoxy(1,6);
m[1]:='Расчет заработной платы';
m[2]:='Расчет премий';
m[3]:='Коммунальные услуги';
m[4]:='Просмотр инф-ии о сотр.';
m[5]:='Гистограмма';
m[6]:='Выход';
for i:=1 to 6 do
if i=j then writeln('>> ', m[i])
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure BUzarplata;
var fz: file of zarp;
fp: file of rasp;
user: rasp;
zarplata: zarp;
i:integer;
raschet: real;
begin
writeln('ФИО':10,'Должность':15,'Зарплата':15);
for i:=1 to 40 do write('-');
writeln;
assign(fp,'raspisanie.pk229'); reset(fp);
assign(fz,'zarplata.pk229'); rewrite(fz);
while not(EOF(fp)) do
begin
read(fp,user);
raschet:= user.oklad + user.kolstavok * user.stavka;
zarplata.FIO:=user.FIO;
zarplata.doljnost:=user.doljnost;
zarplata.dengi:=raschet;
writeln(user.FIO:10, user.doljnost:15, raschet:15:2);
write(fz,zarplata);
end;
close(fp); close(fz);
clrbuf; repeat until keypressed;
end;
procedure BUpremia;
var fz: file of zarp;
fp: file of rasp;
user: rasp;
premia: zarp;
i:integer;
prem, raschet: real;
begin
write('Введите размер премии (%): '); readln(prem); writeln;
writeln('ФИО':10,'Должность':15,'Зарплата':15,'Премия':15,'Итого':15);
for i:=1 to 70 do write('-');
writeln;
assign(fp,'raspisanie.pk229'); reset(fp);
assign(fz,'premia.pk229'); rewrite(fz);
while not(EOF(fp)) do
begin
read(fp,user);
raschet:= user.oklad + user.kolstavok * user.stavka;
premia.FIO:=user.FIO;
premia.doljnost:=user.doljnost;
premia.dengi:= (prem/100) * raschet;
writeln(user.FIO:10, user.doljnost:15, raschet:15:2,((prem/100) * raschet):15:2, ((prem/100) * raschet + raschet):15:2);
write(fz,premia);
end;
close(fp); close(fz);
clrbuf; repeat until keypressed;
end;
procedure BUkomuslugi;
var Y:integer;
v,kv,e,ke,g,kg,m,km:real;
begin
check('Введите тариф за воду: ',v); check('Введите кол-во: ',kv);
check('Введите тариф за электричество: ',e); check('Введите кол-во: ',ke);
check('Введите тариф за газ: ',g); check('Введите кол-во: ',kg);
check('Введите тариф за мусор: ',m); check('Введите кол-во: ',km);
write('Всего начисленно: ',v*kv:0:2,' + ', e*ke:0:2,' + ', g*kg:0:2,' + ', m*km:0:2,' = ',v*kv+e*ke+g*kg+m*km:0:2);
clrbuf; repeat until keypressed;
end;
function randclr:integer;
var o1,o2,o3:integer;
begin
o1:=random(200)+51;
o2:=random(200)*100+51;
o3:=random(200)*10000+51;
randclr:=o1+o2+o3;
end;
procedure BUgistogramma;
var mash,max:real;
count:byte;
adn:string;
fz: file of zarp;
gis:zarp;
ast:0..1;
x,y,clr:integer;
begin
writeln('Выберите тип гистограммы 0-обычная ; 1-графическая');
readln(ast);
if ast=0 then
begin
clrscr;
max:=0;
assign(fz,'zarplata.pk229'); reset(fz);
while not(EOF(fz)) do
begin
read(fz,gis);
if gis.dengi>max then max:=gis.dengi;
end;
mash:=max/55; // 55-максимальное кол-во палочек
reset(fz);
while not(EOF(fz)) do
begin
read(fz,gis);
write(gis.FIO:10, gis.dengi:10:2, ' : ');
for i:=1 to round(gis.dengi/mash) do write('|');
writeln;
end;
close(fz);
clrbuf; repeat until keypressed;
end;
if ast=1 then
begin
count:=0;
clrscr;
max:=0;
assign(fz,'zarplata.pk229'); reset(fz);
while not(EOF(fz)) do
begin
count:=count+1;
read(fz,gis);
if gis.dengi>max then max:=gis.dengi;
end;
mash:=max/50;
reset(fz);
x:=20;
y:=-85;
while not(EOF(fz)) do
begin
y:=y+(320 div count);
adn:=inttostr(round(gis.dengi));
read(fz,gis);
clr:=randclr;
rectangle(630,y,(round(gis.dengi)*-1)+630,y+(320 div count)-5);
rectangle(x+3,y+6,x+(9*length(gis.fio)+10),y+25);
textout(x+5,y+8,gis.FIO);
//rectangle(568,y+6,620,y+25);
//(570,y+8,adn);
floodfill(628,y+2,clr);
floodfill(1,1,randclr);
end;
close(fz);
clrbuf; repeat until keypressed;
end;
end;
procedure indexBuh;
begin
j:=1;
repeat
clrscr; BUmenu;
clrbuf; d:=readkey;
if d=#0 then
begin
d:=readkey;
if (d=#72) then
if j=1 then j:=6
else j:=j-1;
if d=#80 then
if j=6 then j:=1
else j:=j+1;
end
else
begin
if d=#13 then
case j of
1: BUzarplata;
2: BUpremia;
3: BUkomuslugi;
4: UKprosmotr;
5: BUgistogramma;
6: break;
end;
end;
until 2+2=5;
end;
end.
Модуль кадры
unit UKadri;
interface
uses crt, URaspis, Udop;
type
kadri=record
FIO:string[30];
datarojd:string[10];
pol:char;
doljnost:string[20];
stavka:integer;
end;
var
user:kadri;
m:array[1..7] of string[25];
i,j:integer;
d:char;
implementation
procedure UKmenu;
begin
gotoxy(25,3);
writeln('Модуль кадров');
gotoxy(1,6);
m[1]:='Информация о сотруднике';
m[2]:='Добавление сотрудника';
m[3]:='Увальнение сотрудника';
m[4]:='Редактирование';
m[5]:='Архив';
m[6]:='Штатное расписание';
m[7]:='Выход';
for i:=1 to 7 do
if i=j then
writeln('>> ', m[i])
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure UKprosmotr;
var fp: file of kadri;
i:integer;
begin
writeln('ФИО':10,'Дата рождения':15,'Пол':8,'Должность':15,'Ставка':10);
for i:=1 to 58 do write('-');
writeln;
assign(fp,'kadri.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
writeln(user.FIO:10,user.datarojd:15, user.pol:8, user.doljnost:15, user.stavka:10);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
procedure UKdobavlenie;
var fp: file of kadri;
fr: file of rasp;
raspis: rasp;
flag:boolean;
FIO:string[20];
begin
repeat
flag:=false;
writeln; writeln;
write('Введите ФИО -> '); readln(FIO); raspis.FIO:=FIO;
assign(fp,'kadri.pk229');
reset(fp);
while not(EOF(fp)) and not(flag) do
begin
read(fp,user);
if user.FIO=FIO then flag:=true;
end;
close(fp);
if flag then writeln('Такой пользователь уже существует');
until not(flag);
user.FIO:=FIO;
write('Введите дату рождения -> '); readln(user.datarojd);
write('Введите пол ->'); readln(user.pol);
write('Введите должность ->'); read(user.doljnost); raspis.doljnost:=user.doljnost;
checkIn('Введите ставку ->',user.stavka); raspis.stavka:=user.stavka;
checkIn('Введите кол-во ставок ->',raspis.kolstavok);
checkIn('Введите оклад ->',raspis.oklad);
assign(fp,'kadri.pk229');
reset(fp); seek(fp,fileSize(fp)); write(fp,user);
close(fp);
assign(fr,'raspisanie.pk229');
reset(fr); seek(fr,fileSize(fr)); write(fr,raspis);
close(fr);
end;
procedure UKuvolnenie;
var poisk:string[20];
fi,fo: file of kadri;
mass: array[1..10] of kadri;
i,k:integer;
begin
write('Введите имя пользователя: '); readln(poisk);
assign(fi,'kadri.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if not(user.FIO=poisk)
then begin
mass[i]:=user;
inc(i);
end
else begin
assign(fo,'kadriud.pk229');
reset(fo);
seek(fo,FileSize(fo));
write(fo,user);
close(fo);
end;
end;
close(fi);
rewrite(fi);
for k:=1 to i-1 do
write(fi,mass[k]);
close(fi);
end;
procedure UKredaktirovanie;
var poisk,newpass,r,k:string[30];
fi: file of kadri;
i,a:integer;
d:char;
begin
write('Введите имя пользователя: '); readln(poisk);
assign(fi,'kadri.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if (user.FIO=poisk)
then begin
writeln('Выберите пункт меню');
writeln('1 Редактирование должности');
writeln('2 Редактирование ставки');
clrbuf; d:=readkey;
case d of
#49: begin writeln('Введите новую должность: '); read(r); user.doljnost:=r; end;
#50: begin writeln('Введите новую ставку: '); read(a); user.stavka:=a; end;
end;
seek(fi,i-1);
write(fi,user);
end;
inc(i);
end;
close(fi);
end;
procedure UKarchive;
var fp,fo: file of kadri;
st:string[30];
i,k:integer;
d:char;
mass: array[1..10] of kadri;
begin
writeln;
writeln('Выберите пункт меню');
writeln('1 Просмотр уволенных');
writeln('2 Восстановление уволенного');
clrbuf; d:=readkey;
case d of
#49: begin
writeln('ФИО':10,'Дата рождения':15,'Пол':5,'Должность':12,'Ставка':8);
for i:=1 to 50 do write('-'); writeln;
assign(fp,'kadriud.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
writeln(user.FIO:10,user.datarojd:15, user.pol:5, user.doljnost:12, user.stavka:8);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
#50: begin
i:=1;
write('Введите ФИО: '); read(st);
assign(fp,'kadriud.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
if not(user.FIO=st) then begin mass[i]:=user; inc(i); end
else begin
assign(fo,'kadri.pk229');
reset(fo);
seek(fo,FileSize(fo));
write(fo,user);
close(fo);
end;
end;
close(fp); rewrite(fp);
for k:=1 to i-1 do
write(fp,mass[k]);
close(fp);
end;
end;
end;
procedure indexKadri;
begin
j:=1;
repeat
clrscr;
UKmenu;
clrbuf;
d:=readkey;
if d=#0 then
begin
d:=readkey;
if d=#72 then
begin
if j=1 then j:=7
else j:=j-1;
end;
if d=#80 then
begin
if j=7 then j:=1
else j:=j+1;
end;
end
else
begin
if d=#13 then
begin
case j of
1: UKprosmotr;
2: UKdobavlenie;
3: UKuvolnenie;
4: UKredaktirovanie;
5: UKarchive;
6: indexRaspis;
7: break;
end;
end;
end;
until 2+2=5;
end;
end.
Модуль касса
unit Ukassa;
interface
uses crt, Usklad, Upoisktov, Udop;
type
kassa=record
IP:integer;
vremy:string[10];
nazvanie:string[20];
kol:integer;
cena:integer;
vsumme:integer;
vnos:integer;
sdacha:integer;
pribl:integer;
end;
var
dohod:kassa;
m:array[1..7] of string[25];
i,j:integer;
d:char;
implementation
procedure KSmenu;
begin
gotoxy(25,3);
writeln('Модуль кассира');
gotoxy(1,6);
m[1]:='Просмотр товара';
m[2]:='Филтрация товара';
m[3]:='Продажа товара';
m[4]:='История продаж';
m[5]:='Выход';
for i:=1 to 5 do
if i=j then
writeln('0=> ', m[i], '<=0')
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure KSfilter;
var ch:char;
ar:array[1..10] of char;
count:byte;
str:string;
ft:file of tovar;
tov:tovar;
begin
clrscr;
count:=0; str:='';
write('ВВедите название товара: '); clrbuf;
while not(keypressed) do
begin
ch:=readkey;
if(ch=#13) then break;
clrscr;
write('ВВедите название товара: ');
inc(count);
if ch<>#13 then
begin
ar[count]:=ch;
str:=str+ar[count];
writeln(str);
assign(ft,'sklad.pk229');
reset(ft);
writeln;
writeln('IP/Артикуль':10,'Название':10,'Цена':10,'Колличество':15,'Срок годности':15,'Дата закупки':15);
for i:=1 to 75 do write('-');
writeln;
while not(EOF(ft)) do
begin
read(ft,tov);
j:=0;
for i:=1 to length(str) do
if (tov.nazvanie[i]=str[i]) then inc(j);
if j=length(str) then writeln(tov.IP:10,tov.nazvanie:10, tov.cena:10, tov.kol:15, tov.srokgod:15, tov.datazakup:15);
end;
close(ft);
end;
clrbuf;
end;
end;
procedure KSprodaja;
var fi:file of kassa;
fo:file of tovar;
d:integer;
sd:real;
mass: array[1..10] of kassa;
tov:tovar;
i,k:integer;
begin
writeln; writeln;
write('Введите IP/Артикуль -> '); readln(dohod.IP);
assign(fo,'sklad.pk229');
reset(fo);
i:=1;
while not(EOF(fo)) do
begin
read(fo,tov);
if tov.IP=dohod.IP then
begin
writeln('Название товара -> ',tov.nazvanie); dohod.nazvanie:=tov.nazvanie;
write('Введите цену продажи ->'); readln(dohod.cena);
write('Введите количество ->'); readln(dohod.kol);
tov.kol:=tov.kol-dohod.kol;
seek(fo,i-1);
write(fo,tov);
break;
end;
inc(i);
end;
close(fo);
write('Введите время продажи товара -> '); readln(dohod.vremy);
write('В сумме (цена*количество) ->'); dohod.vsumme:=dohod.cena*dohod.kol; writeln(dohod.vsumme);
write('Сколько денег было полученно: '); readln(dohod.vnos);
write('Сдача ->'); dohod.sdacha:=dohod.vnos-dohod.cena*dohod.kol; writeln(dohod.sdacha);
write('Прибыль ->'); dohod.pribl:=dohod.vsumme-tov.cena*dohod.kol; write(dohod.pribl);
assign(fi,'dohod.pk229');
reset(fi);
seek(fi,FileSize(fi));
write(fi,dohod);
close(fi);
clrbuf; repeat until keypressed;
end;
procedure istpr;
var fp: file of kassa;
i:integer;
begin
writeln('Артикул':8,'Время':7,'Название':11,'Кол-во':7,'Цена':6,'В сумме':8,'Сдача':6,'Прибыль':8);
for i:=1 to 70 do write('-');
writeln;
assign(fp,'dohod.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,dohod);
writeln(dohod.IP:8,dohod.vremy:7, dohod.nazvanie:11, dohod.kol:7, dohod.cena:6, dohod.vsumme:6, dohod.sdacha:6, dohod.pribl:8);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
procedure indexKassa;
begin
j:=1;
repeat
clrscr;
if (j=0) then j:=1;
KSmenu;
clrbuf; d:=readkey;
if d=#0 then
begin
d:=readkey;
if (d=#72) then
if j=1 then j:=5
else j:=j-1;
if d=#80 then
if j=5 then j:=1
else j:=j+1;
end
else
begin
if d=#13 then
case j of
1: indexPoisk;
2: KSfilter;
3: KSprodaja;
4: istpr;
5: break;
end;
end;
until 2+2=5;
end;
end.
Модуль поиск товара
unit Upoisktov;
interface
uses crt, Usklad;
var
m:array[1..8] of string[25];
i,j:integer;
d:char;
implementation
procedure clrbuf;
var ch:char;
begin
while keypressed do ch:=readkey;
end;
procedure PSmenu;
begin
gotoxy(25,3);
writeln('Модуль Поиск товара');
gotoxy(1,6);
m[1]:='По названию';
m[2]:='По цене';
m[3]:='По дате';
m[4]:='По артикулу';
m[5]:='Выход';
for i:=1 to 5 do
if i=j then
writeln('>> ', m[i])
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure PSsearch;
var tov:tovar;
poisk:string[30];
fi:file of tovar;
flag:boolean;
x,code:integer;
begin
write('Введите фразу для поиска: '); read(poisk);
writeln;
writeln('IP/Артикуль':10,'Название':10,'Цена':10,'Колличество':15,'Срок годности':15,'Дата закупки':15);
assign(fi,'sklad.pk229');
reset(fi);
while not(EOF(fi)) do
begin
flag:=false;
read(fi,tov);
case j of
1: if tov.nazvanie=poisk then flag:=true;
2: begin Val(poisk,x,code); if tov.cena=x then flag:=true; end;
3: if tov.datazakup=poisk then flag:=true;
4: begin Val(poisk,x,code); if tov.IP=x then flag:=true; end;
end;
if (flag)
then writeln(tov.IP:10,tov.nazvanie:10, tov.cena:10, tov.kol:15, tov.srokgod:15, tov.datazakup:15);
end;
close(fi);
clrbuf; repeat until keypressed;
end;
procedure indexPoisk;
begin
j:=1;
repeat
clrscr;
PSmenu;
clrbuf;
d:=readkey;
if d=#0 then
begin
d:=readkey;
if d=#72 then
begin
if j=1 then j:=5
else j:=j-1;
end;
if d=#80 then
begin
if j=5 then j:=1
else j:=j+1;
end;
end
else
begin
if d=#13 then
begin
case j of
1..4: PSsearch;
5: break;
end;
end;
end;
until 2+2=5;
end;
end.
Модуль расписание
unit URaspis;
interface
uses crt, Udop;
type
rasp=record
FIO:string[30];
doljnost:string[20];
kolstavok:integer;
oklad:integer;
stavka:integer;
end;
var
user:rasp;
m:array[1..7] of string[25];
i,j:integer;
d:char;
implementation
procedure RAmenu;
begin
gotoxy(25,3);
writeln('Модуль кадров');
gotoxy(1,6);
m[1]:='Просмотр расписания';
m[2]:='Изменение расписания';
m[3]:='Выход';
for i:=1 to 3 do
if i=j then
writeln('>> ', m[i])
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure RAview;
var fp: file of rasp;
i:integer;
begin
writeln(' ':2,'ФИО':9,' ':5,'Должность':9,' ':4,'К ставок':8,' ':4,'Оклад':8,' ':4,'Ставка':6);
for i:=1 to 59 do write('-');
writeln;
assign(fp,'raspisanie.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
writeln(' ':2,user.FIO:10,' ':4,user.doljnost:9,' ':4,user.kolstavok:8, ' ':4, user.oklad:8, ' ':4, user.stavka:6, ' ':4);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
procedure RAchange;
var poisk, news:string[30];
fi: file of rasp;
i, newi:integer;
d:char;
begin
write('Введите имя пользователя: '); readln(poisk);
assign(fi,'raspisanie.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if (user.FIO=poisk)
then begin
writeln('Выберите пункт меню');
writeln('1 Редактирование должности');
writeln('2 Редактирование кол-ва ставок');
writeln('3 Редактирование оклада');
writeln('4 Редактирование ставки');
clrbuf; d:=readkey;
case d of
#49: begin writeln('Введите новую должность: '); read(news); user.doljnost:=news; end;
#50: begin writeln('Введите новое кол-во ставок: '); read(newi); user.kolstavok:=newi; end;
#51: begin writeln('Введите новый оклад: '); read(newi); user.oklad:=newi; end;
#52: begin writeln('Введите новую ставку: '); read(newi); user.stavka:=newi; end;
end;
seek(fi,i-1);
write(fi,user);
end;
inc(i);
end;
close(fi);
end;
procedure indexRaspis;
BEGIN
j:=1;
repeat
clrscr;
RAmenu;
clrbuf;
d:=readkey;
if d=#0 then
begin
d:=readkey;
if d=#72 then
begin
if j=1 then j:=7
else j:=j-1;
end;
if d=#80 then
begin
if j=7 then j:=1
else j:=j+1;
end;
end
else
begin
if d=#13 then
begin
case j of
1: RAview;
2: RAchange;
3: break;
end;
end;
end;
until 2+2=5;
END;
end.
Модуль склад
unit USklad;
interface
uses crt, Udop;
type
tovar=record
IP:integer;
nazvanie:string[20];
cena:integer;
kol:integer;
srokgod:string[15];
datazakup:string[15];
end;
var
user:tovar;
m:array[1..8] of string[25];
i,j:integer;
d:char;
implementation
procedure SKmenu;
begin
gotoxy(25,3);
writeln('Модуль Склада');
gotoxy(1,6);
m[1]:='Просмотр товара';
m[2]:='Добавление товара';
m[3]:='Закупка товара';
m[4]:='Смена цены';
m[5]:='Удалить товар';
m[6]:='Восстановить товар';
m[7]:='Просмотр удаленного товара';
m[8]:='Выход';
for i:=1 to 8 do
if i=j then
writeln('>> ', m[i])
else writeln(' ',m[i]);
writeln;
writeln;
end;
procedure SKprosmotr;
var fp: file of tovar;
i:integer;
begin
writeln('IP/Артикуль':10,'Название':10,'Цена':10,'Колличество':15,'Срок годности':15,'Дата закупки':15);
for i:=1 to 75 do write('-');
writeln;
assign(fp,'sklad.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
writeln(user.IP:10,user.nazvanie:10, user.cena:10, user.kol:15, user.srokgod:15, user.datazakup:15);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
procedure SKdobavlenie;
var fp: file of tovar;
IP,cena,kol:integer;
flag:boolean;
begin
repeat
flag:=false;
writeln; writeln;
repeat
write('Введите IP/Артикуль -> '); readln(IP); if IP<0 then writeln('Ошибка ввода');
until IP>0;
assign(fp,'sklad.pk229');
reset(fp);
while not(EOF(fp)) and not(flag) do
begin
read(fp,user);
if user.IP=IP then flag:=true;
end;
close(fp);
if flag then writeln('Такой артикуль уже существует');
until not(flag);
user.IP:=IP;
write('Введите название -> '); readln(user.nazvanie);
repeat
write('Введите цена ->'); readln(cena); if cena<0 then writeln('Ошибка ввода');
until cena>0;
user.cena:=cena;
repeat
write('Введите колличество ->'); read(kol); if kol<0 then writeln('Ошибка ввода');
until kol>0;
user.kol:=kol;
write('Введите срок годности ->'); read(user.srokgod);
write('Введите дата закупки ->'); read(user.datazakup);
assign(fp,'sklad.pk229');
reset(fp);
seek(fp,fileSize(fp));
write(fp,user);
close(fp);
end;
procedure SKzakupka;
var poisk:string[30];
fi: file of tovar;
i,a:integer;
begin
write('Введите название товара: '); readln(poisk);
assign(fi,'sklad.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if (user.nazvanie=poisk)
then begin
repeat
write('Введите сколько закуплено: ');
readln(a); if a<0 then writeln('Ошибка ввода');
until a>0;
user.kol:=user.kol+a;
seek(fi,i-1);
write(fi,user);
end;
inc(i);
end;
close(fi);
end;
procedure SKsmenaceny;
var poisk,newpass,r,k:string[30];
fi: file of tovar;
i,a:integer;
d:char;
begin
write('Введите название товара: '); readln(poisk);
assign(fi,'sklad.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if (user.nazvanie=poisk)
then begin
repeat
write('Введите новую цену выбранного товара:');
readln(a); if a<0 then writeln('Ошибка ввода');
until a>0;
user.cena:=a;
seek(fi,i-1);
write(fi,user);
end;
inc(i);
end;
close(fi);
end;
procedure SKudalenie;
var poisk:integer;
fi,fo: file of tovar;
mass: array[1..10] of tovar;
i,k:integer;
begin
write('Введите артикуль товара: '); readln(poisk);
assign(fi,'sklad.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if not(user.IP=poisk)
then begin
mass[i]:=user;
inc(i);
end
else begin
assign(fo,'skladud.pk229');
reset(fo);
seek(fo,FileSize(fo));
write(fo,user);
close(fo);
end;
end;
close(fi);
rewrite(fi);
for k:=1 to i-1 do
write(fi,mass[k]);
close(fi);
end;
procedure SKprosmotrud;
var fp: file of tovar;
i:integer;
begin
writeln('IP/Артикуль':10,'Название':10,'Цена':10,'Колличество':15,'Срок годности':15,'Дата закупки':15);
for i:=1 to 75 do write('-');
writeln;
assign(fp,'skladud.pk229');
reset(fp);
while not(EOF(fp)) do
begin
read(fp,user);
writeln(user.IP:10,user.nazvanie:10, user.cena:10, user.kol:15, user.srokgod:15, user.datazakup:15);
end;
close(fp);
clrbuf; repeat until keypressed;
end;
procedure SKvosstanovlenie;
var poisk:string[20];
fi,fo: file of tovar;
mass: array[1..10] of tovar;
i,k:integer;
begin
write('Введите название товара: '); readln(poisk);
assign(fi,'skladud.pk229');
reset(fi);
i:=1;
while not(EOF(fi)) do
begin
read(fi,user);
if not(user.nazvanie=poisk)
then begin
mass[i]:=user;
inc(i);
end
else begin
assign(fo,'sklad.pk229');
reset(fo);
k:=FileSize(fo);
seek(fo,k);
write(fo,user);
close(fo);
end;
end;
close(fi);
rewrite(fi);
for k:=1 to i-1 do
write(fi,mass[k]);
close(fi);
end;
procedure indexSklad;
begin
j:=1;
repeat
clrscr;
SKmenu;
clrbuf;
d:=readkey;
if d=#0 then
begin
d:=readkey;
if d=#72 then
begin
if j=1 then j:=8
else j:=j-1;
end;
if d=#80 then
begin
if j=8 then j:=1
else j:=j+1;
end;
end
else
begin
if d=#13 then
begin
case j of
1: SKprosmotr;
2: SKdobavlenie;
3: SKzakupka;
4: SKsmenaceny;
5: SKudalenie;
6: SKvosstanovlenie;
7: SKprosmotrud;
8: break;
end;
end;
end;
until 2+2=5;
end;
end.
Скриншоты:
Рис 16.
Рис 17.
Рис 18.
Рис 19.
Рис 20.
Рис 21.
Рис 22.
Рис 23.
Схема:
main
Админ
Бухгалтерия
Касса
Склад
Кадры
