любая клав.'lastkey()=27resource off'' to s,nsresource on='^w-сохр'
ns='^q-не сохр'
*z='F3-поиск ^n-доп. ^t-удал ^p-печать^pgup-^pgdn-'
PROCEDURE poiskKEY CLEAR=RECNO()=''CASEPROMPT()='По ФИО'ORDER TO FIOWINDO poisk
@ 1,1 SAY 'ВВЕДИТЕ ФАМИЛИЮ' GET a PICTURE '@!'DEFAU SPACE(20)
READ=ALLTRIM(a)
CASE PROMPT()='По таб номеру'ORDER TO TABWINDO poisk
@ 1,1 SAY 'ВВЕДИТЕ ТАБ N°' GET a PICTURE '999'DEFAU 0=srt(a,3)
srt='ПОИСК ПО ТАБЕЛЮ'
CASE PROMPT()='По дате'ORDER TO DATEWINDO poisk={}
@ 1,1 SAY 'ВВЕДИТЕ ТАБ N°' GET a PICTURE ''
READ
?????????????? d=='ПОИСК ПО ДАТЕ'
CASE PROMPT()='По шифру детали'ORDER TO SHRIFWINDO poisk
@ 1,1 SAY 'ВВЕДИТЕ N° ДЕТАЛИ' GET a PICTURE '999'DEFAU 0
???????????? d=srt(a,3)
srt='ПОИСК ПО ШРИФТУ'
CASE PROMPT()='По выработке'ORDER TO VIRABWINDO poisk
@ 1,1 SAY 'ВВЕДИТЕ N° ДЕТАЛИ' GET a PICTURE '999'DEFAU 0
???????????? d=srt(a,3)
srt='ПОИСК ПО ШРИФТУ'MENU manu
**---------Программа POISK.PRG---------
**Программа осуществляет возможность поиска. В случае удачи запись выводится программой
**PRIN в дополнительном окне, иначе выводится сообщение об
**не удачном поиске.
set talk off=space(10)
***********************************WINDOW PSK1 from 10,12 to 14,66 DOUBLE CLOSE SHADOW color scheme 5 TITLE ' INPUT DATE FOR SEARCH 'WINDOW PSK2 from 5,18 to 14,64 DOUBLE CLOSE SHADOW color g+/n TITLE 'RESULT OF SEARCH '
************************************WINDOW PSK1
fio2=" "
@ 1,1 say 'Введите,пожалуйста,фамилию ' get fio2WINDOW PSK1
*DO TRANSLATION_OF_SURNAMESfor fio=fio2fio<>fio2cursor offWINDOW PSK2
@ 3,0 say " В БАЗЕ ДАННЫХ ТАКАЯ ФАМИЛИЯ" color w+/n
@ 3,29 say "ОТСУТСВУЕТ" color w+*/ncursor onWINDOW PSK2WINDOW PSK1 FROM 14,1 TO 23,78 color scheme 5WINDOW PSK2CURSOR OFFSEMPSEMP
@ 0,0 say " Табельный номер: ║"+padl(tab,18)
@ 1,0 say " Фамилия Имя Отчество: ║"+padl(fio,18)
@ 2,0 say " Дата рождения: ║"+padl(gr,18)
*@ 3,0 say " Семейное положение: ║"+padl(sem2,18)
@ 3,0 say " Количество детей: ║"+padl(deti,18)
@ 4,0 say " Размер оклада: ║"+padl(oklad,18)+" $"
@ 5,0 say " Занимаемая должность: ║"+padl(dol,18)
@ 6,0 say " Удерживаемый налог: ║"+padl(b.nal,18)+" $"
readCURSOR ONWINDOW PSK2
**************************************
*PROCEDURE TRANSLATION_OF_SURNAMES
*DO CASE
* CASE fio2="Абакарова Р."
* fio2="Abukarova R."
* CASE fio2="Абдулаева Э."
* fio2="Abdulaeva E."
* OTHERWISE fio2
*ENDCASE
*RETURN
****************************************talk off=space(10)
***********************************WINDOW PSK1 from 10,19 to 14,60 DOUBLE CLOSE SHADOW color scheme 5 TITLE ' ВВЕДИТЕ ТАБ НОМЕР ДЛЯ ПОИСКА'WINDOW PSK2 from 5,18 to 14,64 DOUBLE CLOSE SHADOW color g+/n TITLE 'RESULT OF SEARCH '
************************************WINDOW PSK1
tab2='00'
@ 1,1 say 'Введите,пожалуйста,табельный номер ' get tab2
readWINDOW PSK1tab2found()
*locate for tab=tab2
*if tab<>tab2WINDOW PSK1 FROM 14,1 TO 23,78 color scheme 5WINDOW PSK2SEMPSEMP
@ 0,0 say " Табельный номер: ║"+padl(tab,18)
@ 1,0 say " Фамилия Имя Отчество: ║"+padl(fio,18)
@ 2,0 say " Дата рождения: ║"+padl(gr,18)
*@ 3,0 say " Семейное положение: ║"+padl(sem,1)
@ 3,0 say " Количество детей: ║"+padl(deti,18)
@ 4,0 say " Размер оклада: ║"+padl(oklad,18)+" $"
@ 5,0 say " Занимаемая должность: ║"+padl(dol,18)
@ 6,0 say " Удерживаемый налог: ║"+padl(b.nal,18)+" $"
readWINDOW PSK2WINDOW PSK2cursor off
@ 3,3 say "В БАЗЕ ДАННЫХ ТАКОЙ ТАБЕЛЬНЫЙ НОМЕР" color w+/n
@ 4,15 say "ОТСУТСВУЕТ" color w+*/ncursor onWINDOW PSK2
endif
**---------Программа FLT_FIO---------**talk off
***********************************WINDOW FLT1 from 10,12 to 12,61 CLOSE SHADOW color scheme 5 TITLE ' INPUT DATE FOR SEARCH '
************************************WINDOW FLT1=space(10)
@ 0,1 say 'Введите,пожалуйста,ключ фильтрации:' get kluchWINDOW FLT1=ALLTRIM(kluch)ZAMENAFILTER TO fio=kluch
**********************************************ZAMENA=' '=SUBSTR(kluch,1,1)CASEk="a" k="A"k="b" k="B"k="c" k="C"k="d" k="D"k="e" k="E"k="f" k="F"k="g" k="G"k="h" k="H"k="i" k="I"k="j" k="J"k="k" k="K"k="l" k="L"k="m" k="M"k="n" k="N"k="o" k="O"k="p" k="P"k="q" k="Q"k="r" k="R"k="s" k="S"k="t" k="T"k="u" k="U"k="v" k="V"k="w" k="W"k="x" k="X"k="y" k="Y"k="z" k="Z"k=STUFF(kluch,1,1,k)
RETURN
**********************************************
**---------Программа FLT_OKL1 ---------**talk off
***********************************WINDOW FLT1 from 10,12 to 12,64 DOUBLE CLOSE SHADOW color scheme 5 TITLE ' INPUT DATE FOR SEARCH '
************************************WINDOW FLT1
kl=000.0
@ 0,1 say 'Введите,пожалуйста,ключ фильтрации:' get kl
readWINDOW FLT1FILTER TO oklad=kl
*************************************window WIWfields tab :h='Taб номер: ',fio :h='Фамилия : ', gr :h='Год рождения: ',sem :h='Сем пол: ', deti :h='Дети: ',oklad :h='Оклад : ', zar :h='Зар плата: ',dol :h='Должность: ',b.nal:h='Налог за бездетность: ' nomodify nodelete noappendwindow WIW
RETURN
**---------Программа FLT_OKL2 ---------**talk off
***********************************WINDOW FLT1 from 10,12 to 12,64 DOUBLE CLOSE SHADOW color scheme 5 TITLE ' INPUT DATE FOR SEARCH '
************************************WINDOW FLT1
kl=000.0
@ 0,1 say 'Введите,пожалуйста,ключ фильтрации:' get kl
readWINDOW FLT1FILTER TO oklad>=kl
*************************************window WIWfields tab :h='Taб номер: ',fio :h='Фамилия : ', gr :h='Год рождения: ',sem :h='Сем пол: ', deti :h='Дети: ',oklad :h='Оклад : ', zar :h='Зар плата: ',dol :h='Должность: ',b.nal:h='Налог за бездетность: ' nomodify nodelete noappendwindow WIW
RETURN
**********************************************
**---------Программа FLT_OKL3 ---------**
set talk off
***********************************WINDOW FLT1 from 10,12 to 12,64 DOUBLE CLOSE SHADOW;scheme 5 TITLE ' INPUT DATE FOR SEARCH '
************************************WINDOW FLT1
kl=000.0
@ 0,1 say 'Введите,пожалуйста,ключ фильтрации:' get kl
readWINDOW FLT1FILTER TO oklad<=kl
*************************************window WIW;;:h='Taбельный номер : ',;
fio :h='Фамилия, Имя, Отчество: ',;:h='Год рождения: ',;
sm=IIF(sem='Н','not married',IIF(sem='Б','married','divorced'));
:h='Семейное положение: ',;:h='Количество детей: ',;
oklad:h='Оклад: ',;
zar :h='Заработная плата: ',;:h='Должность: ',;.nal:h='Налог за бездетность: ' ;
redit in window WIW partition 12 lpartition ;nomodify nodelete noappendwindow WIW
**********************************************talk off
*DEFINE POPUP mform FROM 1,30 SHADOW
*DEFINE BAR 1 OF mform PROMPT 'Ведомость по з/п';
* message 'Просмотр Базы Данных на членов бригады' COLOR,,,,w+/r
*DEFINE BAR 2 OF mform PROMPT 'Выпуск продукции';
* message 'Ввод новой записи' COLOR,,,,w+/r
*DEFINE BAR 3 OF mform PROMPT 'Отчет';*
* message 'Вывод Базы Данных на членов бригады в файл "brig.dbf"' COLOR,,,,w+/r
ON SELECTION BAR 1 OF mform DO z.pSELECTION BAR 2 OF mform DO viraSELECTION BAR 3 OF mdann DO otch
*acti popup mformz.pfields tab :h='Taб номер: ',fio :h='Фамилия : ', oklad :h='Оклад : ', zar :h='Зар плата: ',dol :h='Должность: ',b.nal:h='Налог за бездетность: ' nomodify nodelete noappendvirafields tab :h='Taб номер: ',fio :h='Фамилия : ', oklad :h='Оклад : ', zar :h='Зар плата: ',dol :h='Должность: ',b.nal:h='Налог за бездетность: ' nomodify nodelete noappendfields tab :h='Taб номер: ',fio :h='Фамилия : ', oklad :h='Оклад : ', zar :h='Зар плата: ',dol :h='Должность: ',b.nal:h='Налог за бездетность: ' nomodify nodelete noappendtalk offdate GERMANmacrosclock onBRIG508 IN A INDEX brig508.idx &&audi2.dbf IN A INDEX audi2.cdxNAL508 IN B INDEX nal508.idx &&audi.dbf IN b INDEX audi.idx
*USE audimes IN c INDEX audimes.idx
*USE audinal IN d INDEX audinal.idxARELATION TO TAB INTO B
*SET RELATION TO n_mes INTO C
*SET RELATION TO TAB INTO D_min=83
*obl=a.nachis-(z_min*a.deti)
* REPLACE nal WITH d.podh+d.pf+d.med+d.det,;
* nachis WITH nach*(c.chislo-progul),;
* zarp WITH nachis-nal,;a(10)WINDOW WW from 3,5 to 16,73 SHADOW color scheme 5 TITLE ' Окно ввода 'WINDOW WIW from 3,5 to 14,73 SHADOW color scheme 7 TITLE ' Окно вывода 'WINDOW AR from 3,8 to 17,70 CLOSE SHADOW color scheme 7 TITLE ' About Programm 'WINDOW MAIN FROM 0,0 TO 24,79 TITLE ' WITH DATABASES ' NOCLOSE FILL '▒' COLOR bg/n
** Определение главного BAR-меню MENU0 ****MENU menu0 SHADOW colorPAD dann OF menu0 PROMPT 'ДАННЫЕ'PAD deistv OF menu0 PROMPT 'ДЕЙСТВИЯ'PAD form OF menu0 PROMPT 'ФОРМЫ'PAD poi OF menu0 PROMPT 'СЕРВИС'PAD vihod OF menu0 PROMPT 'ВЫХОД'SELECTION PAD dann OF menu0 ACTIVATE POPUP mdannSELECTION PAD deistv OF menu0 ACTIVATE POPUP mdeistvSELECTION PAD vihod OF menu0 ACTIVATE POPUP mvihodSELECTION PAD form OF menu0 ACTIVATE POPUP mformSELECTION PAD poi OF menu0 ACTIVATE POPUP mpoiskPOPUP mdann FROM 1,0 SHADOWBAR 1 OF mdann PROMPT 'Посмотр данных';
message 'Просмотр Базы Данных на членов бригады' COLOR,,,,w+/r
DEFINE BAR 2 OF mdann PROMPT 'Ввод данных';'Ввод новой записи' COLOR,,,,w+/rBAR 3 OF mdann PROMPT 'Вывод данных в файл';
message 'Вывод Базы Данных на членов бригады в файл "brig.dbf"' COLOR,,,,w+/r
ON SELECTION BAR 1 OF mdann DO BRSELECTION BAR 2 OF mdann DO WWOD with 1SELECTION BAR 3 OF mdann DO CREATF
***********************************POPUP mpoisk FROM 2,33 SHADOWBAR 1 OF mpoisk PROMPT 'По номеру';
message 'Поиск члена бригады по табельному номеру' COLOR,,,,w+/r
DEFINE BAR 2 OF mpoisk PROMPT 'По фамилии';
message 'Поиск члена бригады по фамилии' COLOR,,,,w+/r
ON SELECTION BAR 1 OF mpoisk DO poisk_n.prgSELECTION BAR 2 OF mpoisk DO poisk_f.prg
**************************************POPUP mfiltr FROM 3,33 SHADOWBAR 1 OF mfiltr PROMPT 'По фамилии';
message 'Фильтрация базы данных по фамилии' COLOR,,,,w+/r
DEFINE BAR 2 OF mfiltr PROMPT 'По окладу _';
message 'Фильтрация базы данных по окладу' COLOR,,,,w+/r
ON SELECTION BAR 1 OF mfiltr DO flt_fio.prgSELECTION BAR 2 OF mfiltr ACTIVATE POPUP mflt2
**************************************POPUP mdeistv FROM 1,9 SHADOWBAR 1 OF mdeistv PROMPT 'Поиск данных _';
message 'Поиск записи на члена бригады' COLOR,,,,w+/r
DEFINE BAR 2 OF mdeistv PROMPT 'Фильтрация данных _';
DEFINE BAR 3 OF mdeistv PROMPT 'Редактирование данных ';
message 'Редактирование выбранной записи из Базы Данных' COLOR,,,,w+/r
DEFINE BAR 4 OF mdeistv PROMPT 'Печать данных ';
message 'Печать выбранной записи из Базы Данных' COLOR,,,,w+/r
ON SELECTION BAR 1 OF mdeistv ACTIVATE POPUP mpoiskSELECTION BAR 2 OF mdeistv ACTIVATE POPUP mfiltrSELECTION BAR 3 OF mdeistv DO WWOD with 2SELECTION BAR 4 OF mdeistv DO PECHAT.PRG
**************************************POPUP mform FROM 1,20 SHADOWBAR 1 OF mform PROMPT 'Ведомость по з/п';
message 'Просмотр Ведомости по з/п на членов бригады' COLOR,,,,w+/r
DEFINE BAR 2 OF mform PROMPT 'Выпуск продукции';
message 'Просмотр ведомости по выпуску продукции' COLOR,,,,w+/r
DEFINE BAR 3 OF mform PROMPT 'Отчет';
message 'Вывод отчетов по з/п и выпуску продукции ' COLOR,,,,w+/r
ON SELECTION POPUP mform DO form.prg
*acti popup mformPOPUP mflt2 FROM 5,47 SHADOWBAR 1 OF mflt2 PROMPT '= заданному окладу';
message 'Вывод списка членов бригады имеющих данный оклад' COLOR,,,,w+/r
DEFINE BAR 2 OF mflt2 PROMPT '>= заданного оклада';
message 'Вывод списка членов бригады имеющих оклад больший чем данный' COLOR,,,,w+/r
DEFINE BAR 3 OF mflt2 PROMPT '<= заданного оклада';
message 'Вывод списка членов бригады имеющих оклад меньший чем данный' COLOR,,,,w+/r
ON SELECTION BAR 1 OF mflt2 DO flt_okl1.prgSELECTION BAR 2 OF mflt2 DO flt_okl2.prgSELECTION BAR 3 OF mflt2 DO flt_okl3.prg
**************************************POPUP mvihod FROM 1,37 SHADOWBAR 1 OF mvihod PROMPT 'Выход в DOS';'Выход в OS DOS' COLOR,,,,w+/rBAR 2 OF mvihod PROMPT 'Выход в FoxPro';'Выход в оболочку FoxPro' COLOR,,,,w+/rSELECTION BAR 1 OF mvihod QUITSELECTION BAR 2 OF mvihod Do conec
** Основная программа ***WINDOW MAINMENU menu0window WW,WIWMENU menu0WINDOW MAINclock offBRwindow WIWfields tab :h='Taб номер: ',fio :h='Фамилия : ', gr :h='Год рождения: ',sem :h='Сем пол: ', deti :h='Дети: ',oklad :h='Оклад : ', zar :h='Зар плата: ',dol :h='Должность: ',b.nal:h='Налог за бездетность: ' nomodify nodelete noappendwindow WIWWWODvidreccount()=0=1vid=1(1)=space(6)(2)=space(20)(3)={}(4)=' '(5)=0(6)=0(7)=space(20)
a(8)='Введите данные о новом сотрудн'
elsebrFIELDS tab,fio,oklad to a
a(8)='Произведите необходимые преоброзования данных'
endifREADLNa(1)#' 'avid=1blankFROM a FIELDS a.name,kod,predl,cenabvid=1blank
*replace kod with a.kodnal with iif(a.deti=0,a.oklad*0.02,IIf(a.deti=1,;.oklad*0.01,IIF(a.deti=2,a.oklad*0.005,0)))azarpl with a.oklad-b.nal
* if lastkey()!=27
*select a
*dELETE FOR TAB=0
* PACK
* APPEND BLANK
* gather memvar
* SELECT B
* DELETE FOR TAB=0
* PACK
* APPEND BLANK
* * IIF(M.DETI=0,M.OKLAD*0.02,IIF(M.DETI=1,M.OKLAD*0.01,;
* IIF(M.DETI=2,M.OKLAD*0.005,M.OKLAD))),;
* d.podoh WITH
ENDIF
**********************************
** Ввод/изменение данных *********
Procedure readlnwindow WW
@ 1,0 say padc(a(8),WCOLS( )) COLOR SCHEME 5
@ 2,4 say 'Код товара : ' get a(1) valid a(1)#' ';a(1) message ' Введите шифр товара'
@ 3,4 say 'Наименование товара :' get a(2);
default a(2) valid a(2)#' ';
message ' Введите наимен товара: '
*@ 4,4 say 'Год рождения: ' get a(3) range DATE()-80*365,DATE()-16*365;a(3) valid a(3)#{};
message ' Введите год рождения члена бригады '
*@ 5,4 say 'Семейное положение : ' get a(4) FUNCTION 'M Б,Н,Р';a(4);
message 'Н-не в браке, Р-разведен(а),Б-в браке. Выбор-кл. Пробел'
@ 4,4 say 'Цена : ' get a(5) RANGE 0,15;
default a(5) message ' Введите цену единицы товара '
@ 5,4 say 'Предлогаемое к-во : ' get a(6) valid a(6)#0;
default a(6) message ' Введите значение оклада члена бригады '
*@ 8,4 say 'Должность : ' get a(7);a(7) valid a(7)#space(20);
message ' Введите должность члена бригады '
readwindow WW
return
****************************************
Процедура копирования активного файла БД в другой
PROCEDURE CREATFWINDOW mes2 from 10,20 to 12,63 color g+/nTO audi_01bTO audi2_01cTO audimes_01dTO audinal_01aaudi_01 IN abaudi2_01caudimes_01dTO audinal_01WITH a TO audi FOR kod=a.kod FIELDS kod,a.name,a.predl,a.cenasklad_01 index sklad_01 in apokyp_01 index pokyp_01 in bprodav_01 index prodav_01arelation to kod into bWINDOW mes2cursor off
@ 0,1 say "Output data in file is made"
@ 0,29 say "successfully" color g+*/ncursor onWINDOW mes2
return
***********************************
** Вывод авторства программы
PROCEDURE AR_PRGWINDOW AR
close all*USE AUDI.DBFUSE C:\ARSEN\AUDI2.DBF in aUSE C:\ARSEN\AUDIMES.DBF in bsele aset rela to n_mes into bBrowse fields b.mes :h='месяц'deti :h='дети'
А. В. Попов. «FoxPro 2.5/2.6».2000г.
В.Н.Четвериков, Г.И.Ревунков. «Базы и банки данных»,1987г.
М.И.Евдокимов. «Экономическая информатика».1996г.
С.М.Диго.«Проектирование баз данных»,1988г.
П.С.Безруких. «Бухгалтерский учет».1989г.