Материалы сайта
Это интересно
Автоматизированное рабочее место
**************************************************************************** ******* ** Функция - Постоянная часть (Работа с картотекой) ** **************************************************************************** ******* PROCEDURE pos_ch HIDE POPUP kadr IF RECCOUNT()=0 ACTIVATE WINDOW vib @ 1,10 SAY 'Б а з а п у с т а' @ 2,9 SAY 'Начните с дополнения' @ 0,0 FILL TO 8,43 COLOR W+/R @ 5,3 GET ins1 FUNCTION '*TH Дополнить;Отмена' valid ins2() defa 1 size 1,10,4; COLOR ,,,,w+/n,w+/n,w+/n,,W+/R, read cycle OBJECT 1 DEACTIVATE WINDOW vib ELSE GO _REC RELEASE KW,GW,XW,KS,ELC,TL,RD,OT ACTIVATE WINDOW ins STORE .F. TO e,b T=TAB ON KEY LABEL F1 DO HELP WITH 5 ON KEY LABEL F5 ACTIVATE POPUP POISK @ 1,10 get fam disable COLOR SCHEME 15 @ 2,10 get tab disable COLOR SCHEME 15 @ 2,28 get tel disable COLOR SCHEME 15 @ 3,10 get yl disable COLOR SCHEME 15 @ 3,30 get dom picture 'xxxx' disable COLOR SCHEME 15 @ 3,40 get kw_ra picture 'xxxx' disable COLOR SCHEME 15 @ 4,10 get kv_m picture '###.##' disable COLOR SCHEME 15 @ 5,39 get kol_vo picture '99' COLOR SCHEME 12 @ 6,27 GET family FUNCTION '*I ' VALID FAMILY() DEFA 1 SIZE 1,12 =POS_CH1() kw=kw_l gw=g_w_l xw=x_w_l ks=k_ys_l ot=otop_l elc=el_c_l tl=tel_l rd=rad_l @ 10,2 GET kw FUNCTION '*C Квартплата' DEFAULT .F. VALID KW() COLOR SCHEME 16 @ 10,36 get c.kw_pl PICTURE '####.##' disable color scheme 16 @ 11,2 GET gw FUNCTION '*C Горячая вода' VALID GW() defa .f. COLOR SCHEME 16 @ 11,36 get c.g_w disable color scheme 16 @ 12,2 GET xw FUNCTION '*C Холодная вода' VALID XW() DEFA .F. COLOR SCHEME 16 @ 12,36 get c.x_w disable color scheme 16 @ 13,2 GET ks FUNCTION '*C Комунальные услуги' VALID KS() DEFA .F. COLOR SCHEME 16 @ 13,36 get c.k_ysl disable color scheme 16 @ 14,2 GET ot FUNCTION '*C Отопление' VALID OT() DEFA .F. COLOR SCHEME 16 @ 14,36 get c.otopl disable color scheme 16 @ 15,2 GET elc FUNCTION '*C Электроэнергия' VALID ELC() DEFA .F.COLOR SCHEME 16 @ 15,36 get c.el_c disable color scheme 16 @ 16,2 GET tl FUNCTION '*C Телефон' VALID TL() DEFA .F. COLOR SCHEME 16 @ 16,36 get c.tel_r disable color scheme 16 @ 17,2 GET rd FUNCTION '*C Радио' VALID rd() DEFA .F. COLOR SCHEME 16 @ 17,36 get c.rad_r disable color scheme 16 @ 10,28 GET tar_s FUNCTION '*I ;;;;;;;' VALID TARIFS() DEFA 1; COLOR ,,,,GR/BG,GR/BG,,,GR+/BG SIZE 1,7 @ 8,52 GET pros_lg FUNCTION '*N []' VALID PROS_LG() DEFA 1; COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/w+ @ 21,1 GET d.n_lg @ 21,3 GET d.info COLOR ,R/G @ 21,26 GET dat_c COLOR ,B/G @ 21,40 GET dat_po COLOR ,B/G @ 22,10 GET tabl_ras FUNCTION '*N По льготам' valid tab_rslg() DEFAULT 2; COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/w+ @ 22,25 GET tabl_ras1 FUNCTION '*N По оплате' valid tabl_rasop() DEFAULT 2; COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/w+ @ 16,59 GET PEREM FUNCTION '*N Вверх;Вниз' VALID PER() DEFA 1; SIZE 1,8,1 COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/w+ @ 10,65 GET FILTR FUNCTION '*N Плательщики;Льготники;Все жильцы ' valid filtr(); defa 3 @ 16,69 GET PEREM1 FUNCTION '*N Начало;Конец' VALID PER1() DEFA 1; SIZE 1,8,1 COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/w+ @ 0,63 GET attrib FUNCTION '*T Изменить;Добавить' valid attr() defa 2; COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/w+ SIZE 2,14,1 @ 4,63 GET attrib1 FUNCTION '*N Удалить;Печать;Ввод оплаты' valid attr1() defa 2; COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/w+ SIZE 2,14,1 @ 20,63 GET ALL_L FUNCTION '*T Выйти;Расчет'valid vib1_7() default 1; size 2,10,1 COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/gr+ READ CYCLE SHOW tb_l() OBJECT 42 with M_ZAR,VEDOM COLOR SCHEME 7 DEACTIVATE WINDOW INS ENDIF SET ORDER TO adrr ON KEY LABEL F1 DO HELP WITH 6 RETURN FUNCTION POS_CH1 && SAY - Объекты kw=kw_l gw=g_w_l xw=x_w_l ks=k_ys_l ot=otop_l elc=el_c_l tl=tel_l rd=rad_l @ 0,1 to 7,55 double @ 1,2 say 'Фамилия' COLOR SCHEME 12 @ 2,2 say 'Табель' COLOR SCHEME 12 @ 2,20 say 'Телефон' COLOR SCHEME 12 @ 3,2 say 'Адрес: 'COLOR SCHEME 12 @ 3,26 say 'Дом' COLOR SCHEME 12 @ 3,35 say 'Кв-ра'COLOR SCHEME 12 @ 4,2 say 'Площадь'COLOR SCHEME 12 @ 5,2 say 'Количество жильцов - ' +ltrim(str(kol(0))) COLOR SCHEME 12 @ 5,27 say 'Начисляется' COLOR SCHEME 12 @ 5,43 say 'чел.' COLOR SCHEME 12 @ 6,2 say 'Из них льготников - ' +ltrim(str(kl_l(0))) COLOR SCHEME 12 @ 6,27 SAY 'СОСТАВ СЕМЬИ' @ 8,3 SAY 'Услуга' @ 8,28 say 'Тариф' @ 8,36 say 'Расчет' @ 8,45 say 'Льготы' @ 9,2 to 9,55 @ 11,56 SAY 'ФИЛЬТР:' @ 10,28 say LTRIM(STR(kw1(0),5,2)) @ 11,28 SAY LTRIM(STR(GW1(0),5,2)) @ 12,28 SAY LTRIM(STR(XW1(0),5,2)) @ 13,28 SAY LTRIM(STR(KS1(0),5,2)) @ 14,28 SAY LTRIM(STR(OT1(0),5,2)) @ 15,28 SAY LTRIM(STR(ELC1(0),5,2)) @ 16,28 SAY LTRIM(STR(TL3(0),5,2)) @ 17,28 say LTRIM(STR(RD3(0),5,2)) @ 18,2 to 18,55 @ 19,20 SAY 'ИТОГО' @ 19,36 SAY LTRIM(STR(C.ITOG_N,7,2)) @ 20,2 TO 20,55 DOUBLE @ 20,20 SAY 'К ОПЛАТЕ - '+LTRIM(STR(C.ITOG,8,2)) color w+/n @ 21,23 SAY 'C' @ 21,37 say 'по' @ 0,4 say 'F5 - Поиск' color w+/r @ 0,40 say 'F1 - Помощь' color w+/r @ 0,56 FILL TO 23,80 COLOR SCHEME 15 @ 9,2 FILL TO 18,55 COLOR SCHEME 16 FUNCTION OB_NACH && SAY – Объекты начислений по льготам @ 10,45 say LTRIM(STR(c.sum_kw,6,2)) COLOR R/W,,,,,,,,, @ 11,45 say ltrim(str(c.sum_gw,6,2)) color r/W,,,,,,,,, @ 12,45 say ltrim(str(c.sum_xw,6,2)) color r/W,,,,,,,,, @ 13,45 say ltrim(str(c.sum_kysl,6,2)) color r/W,,,,,,,,, @ 14,45 say ltrim(str(c.sum_ot,6,2)) color r/W,,,,,,,,, @ 16,45 say ltrim(str(c.sum_tl,6,2)) color r/W,,,,,,,,, @ 17,45 say ltrim(str(c.sum_rd,6,2)) color r/W,,,,,,,,, @ 19,45 SAY LTRIM(STR(C.SUM_IT,7,2)) @ 9,45 FILL TO 18,55 COLOR SCHEME 16 FUNCTION LG_NACH && SAY – Объекты начислений по льготам @ 10,45 say LTRIM(STR(c.kw_pll,6,2)) COLOR R/W,,,,,,,,, @ 11,45 say ltrim(str(c.g_wl,6,2)) color r/W,,,,,,,,, @ 12,45 say ltrim(str(c.x_wl,6,2)) color r/W,,,,,,,,, @ 13,45 say ltrim(str(c.k_ysll,6,2)) color r/W,,,,,,,,, @ 14,45 say ltrim(str(c.otopll,6,2)) color r/W,,,,,,,,, @ 16,45 say ltrim(str(c.tel_rl,6,2)) color r/W,,,,,,,,, @ 17,45 say ltrim(str(c.rad_rl,6,2)) color r/W,,,,,,,,, @ 19,45 SAY LTRIM(STR(C.ITOG_L,7,2)) @ 9,45 FILL TO 18,55 COLOR SCHEME 16 FUNCTION PROS_LG && Просмотр начислений по льготам DEFINE WINDOW PROSMOTR FROM 10,55 TO 20,75 DO CASE CASE pros_lg=1 ACTIVATE WINDOW PROSMOTR @ 0,1 SAY 'Кв-та ' @ 0,11 SAY LTRIM(STR(C.KW_PLL,6,2)) COLOR N/W @ 1,1 SAY 'Гор.вода ' @ 1,11 SAY LTRIM(STR(C.G_WL,6,2)) COLOR N/W @ 2,1 SAY 'Хол.вода ' @ 2,11 SAY LTRIM(STR(C.X_WL,6,2)) COLOR N/W @ 3,1 SAY 'Ком.усл. ' @ 3,11 SAY LTRIM(STR(C.K_YSLL,6,2)) COLOR N/W @ 4,1 SAY 'Отопление ' @ 4,11 SAY LTRIM(STR(C.OTOPLL,6,2)) COLOR N/W @ 5,1 SAY 'Телефон ' @ 5,11 SAY LTRIM(STR(C.TEL_RL,6,2)) COLOR N/W @ 6,1 SAY 'Радио ' @ 6,11 SAY LTRIM(STR(C.RAD_RL,6,2)) COLOR N/W @ 8,2 SAY 'ИТОГ '+LTRIM(STR(C.ITOG_L,8,2)) COLOR R/W READ RELEASE WINDOW PROSMOTR RETURN FUNCTION tb_l && Функция обновления кнопок(GET) в Процедуре Постоянная часть DO CASE CASE _FILTR=1 SET ORDER TO ord @ 14,57 CLEAR TO 14,76 @ 14,57 SAY 'ФИЛЬТР - ' COLOR W+/B @ 14,66 SAY 'Плательщики' COLOR W+/N CASE _FILTR=2 SET ORDER TO lgt @ 14,57 CLEAR TO 14,76 @ 14,57 SAY 'ФИЛЬТР - ' COLOR W+/B @ 14,66 SAY 'Льготники ' COLOR W+/R CASE _FILTR=3 SET ORDER TO adrr @ 14,57 CLEAR TO 14,76 @ 14,57 SAY 'ФИЛЬТР - ' COLOR W+/B @ 14,66 SAY 'Все жильцы ' COLOR W+/B ENDCASE DO CASE CASE or_r=1.OR.lgot=.T. SHOW GET kw ENABLE COLOR SCHEME 16 SHOW GET gw ENABLE COLOR SCHEME 16 SHOW GET xw ENABLE COLOR SCHEME 16 SHOW GET ks ENABLE COLOR SCHEME 16 SHOW GET ot ENABLE COLOR SCHEME 16 SHOW GET elc ENABLE COLOR SCHEME 16 SHOW GET tl ENABLE COLOR SCHEME 16 SHOW GET rd ENABLE COLOR SCHEME 16 @ 10,2 FILL TO 18,29 COLOR SCHEME 16 CASE or_r=0.OR.lgot=.F. SHOW GET kw DISABLE COLOR ,,,,,,,,,W+/W SHOW GET gw DISABLE COLOR ,,,,,,,,,W+/W SHOW GET xw DISABLE COLOR ,,,,,,,,,W+/W SHOW GET ks DISABLE COLOR ,,,,,,,,,W+/W SHOW GET ot DISABLE COLOR ,,,,,,,,,W+/W SHOW GET elc DISABLE COLOR ,,,,,,,,,W+/W SHOW GET tl DISABLE COLOR ,,,,,,,,,W+/W SHOW GET rd DISABLE COLOR ,,,,,,,,,W+/W @ 10,2 FILL TO 17,26 COLOR SCHEME 12 ENDCASE DO CASE CASE lgot=.f. SHOW GET tabl_ras DISABLE @ 21,1 clear to 21,55 CASE lgot=.t. SHOW GET tabl_ras ENABLE @ 21,1 FILL TO 21,54 COLOR SCHEME 17 ENDCASE DO CASE CASE or_r=0 SHOW GET tabl_ras1 DISABLE SHOW GET pros_lg DISABLE =LG_NACH() CASE or_r=1 SHOW GET tabl_ras1 ENABLE SHOW GET pros_lg ENABLE =OB_NACH() ENDCASE DO CASE CASE e=.F. SHOW GET perem,1 ENABLE SHOW GET perem1,1 ENABLE CASE b=.F. SHOW GET perem,2 ENABLE SHOW GET perem1,2 ENABLE ENDCASE RETURN FUNCTION PER && Перемещения в Базе жильцов (<Вверх><Вниз>) SELE A DO CASE CASE perem=1 cyr=_CUROBJ SKIP -1 IF BOF() show get perem,1 DISABLE GO TOP b=.t. WAIT 'НАЧАЛО БАЗЫ' WIND NOWAIT ELSE STORE .F. TO e,b ENDIF _REC=RECNO() _CUROBJ=cyr CASE perem=2 cyr=_CUROBJ SKIP IF EOF() SHOW GET perem,2 DISABLE GO BOTTOM e=.t. WAIT 'КОНЕЦ БАЗЫ' WIND NOWAIT ELSE store .f. to e,b ENDIF _REC=RECNO() _CUROBJ=cyr ENDCASE SET ORDER TO 0 @ 10,27 CLEAR TO 20,51 =POS_CH1() SHOW GETS RETURN FUNCTION PER1 && Перемещения в Базе жильцов (<Начало><Конец>) DO CASE CASE perem1=2 SHOW GET perem,2 DISABLE SHOW GET perem1,2 DISABLE GO BOTTOM e=.t. WAIT 'КОНЕЦ БАЗЫ' WIND NOWAIT CASE perem1=1 show get perem,1 DISABLE SHOW GET perem1,1 DISABLE GO TOP b=.t. WAIT 'НАЧАЛО БАЗЫ' WIND NOWAIT ENDCASE SET ORDER TO 0 @ 10,27 CLEAR TO 20,51 =POS_CH1() SHOW GETS RETURN FUNCTION FILTR && Выбор фильтра (Льготники,Плат-щики,Все жильцы) DO CASE CASE FILTR=1 _FILTR=1 CASE FILTR=2 _FILTR=2 CASE FILTR=3 _FILTR=3 ENDCASE SHOW GETS RETURN FUNCTION FAMILY && Меню жильцов (СОСТАВ СЕМЬИ) SELE A F=ORDER() SET ORDER TO 0 Y=YL D=DOM K=KW_RA SET FILTER TO Y=YL.AND.D=DOM.AND.K=KW_RA ACTIVATE POPUP FAMIL IF LASTKEY()=13 _REC=RECNO() GO _REC _FILTR=IIF(or_r=1,1,IIF(lgot=.T.,2,3)) SET FILTER TO @ 10,27 CLEAR TO 20,51 =POS_CH1() SHOW GETS ENDIF RETURN FUNCTION ATTR && Выбор кнопок (Добавить,Изменить) DO CASE CASE attrib=1 DO INS WITH 2 IN ADD_DEL CASE attrib=2 DO INS WITH 1 IN ADD_DEL ENDCASE RETURN FUNCTION ATTR1 && Выбор кнопок (Печать,Удалить,Ввод оплаты) DO CASE CASE attrib1=1 DO DEL CASE attrib1=2 DO PRINT1 CASE attrib1=3 DO VVV IN bazes ENDCASE RETURN FUNCTION TAB_RSLG && Таблица ставок по льготам SELE d ON KEY LABEL F1 DO HELP WITH 5 DEFINE WINDOW m_zar FROM 5,15 TO 23,55 SHADOW; TITLE 'Сегодня - '+dtoc(date()) ACTIVATE WINDOW M_ZAR LOCATE FOR n_lg=a.n_lg IF FOUND()=.F. APPEND BLANK REPLACE N_LG WITH a.n_lg @ 14,2 SAY 'Заполните льготные ставки для кода №'+ALLTRIM(STR(A.N_LG)) @ 15,3 SAY 'Введите описание льготы в поле' @ 16,3 SAY 'КАТЕГОРИЯ (н-р: ВЕТЕРАН ТРУДА)' ENDIF @ 1,0 to 1,33 double @ 1,5 SAY a.fam+'Таб.' +ALLTRIM(STR(a.tab)) COLOR SCHEME 13 @ 2,1 to 2,31 @ 2,7 say 'Ввод ставок по льготам' @ 3,5 SAY 'КОД - ' GET n_lg disable @ 4,3 say '%начислений кв.платы' @ 4,29 get kwp_l PICTURE '#.##' @ 4,35 SAY '%' @ 5,3 SAY '%начислений телефона' @ 5,29 get tl_l PICTURE '#.##' @ 5,35 SAY '%' @ 6,3 say '%начислений радио' @ 6,29 get rd_l PICTURE '#.##' @ 6,35 SAY '%' @ 7,3 say '%начислений ком. услуг' @ 7,29 get k_l_l PICTURE '#.##' @ 7,35 SAY '%' @ 8,3 say '%начислений Гор.воды' @ 8,29 get gw_l PICTURE '#.##' @ 8,35 SAY '%' @ 9,3 say '%начислений Хол.воды' @ 9,29 get xw_l PICTURE '#.##' @ 9,35 SAY '%' @ 10,3 say '%начислений отопления' @ 10,29 get ot_l PICTURE '#.##' @ 10,35 SAY '%' @ 12,3 SAY 'КАТЕГОРИЯ' GET info read RELEASE WINDOWS M_ZAR RETURN FUNCTION tabl_rasop && Таблица ставок по оплате SELE g ON KEY LABEL F1 DO HELP WITH 5 DEFINE WINDOW m_zar FROM 5,15 TO 23,55 SHADOW; TITLE 'Сегодня - '+dtoc(date()) ACTIVATE WINDOW M_ZAR @ 1,0 to 1,33 double @ 1,5 SAY a.fam+'Таб.' +ALLTRIM(STR(tab)) COLOR SCHEME 13 @ 2,1 to 2,31 @ 2,7 say 'Ввод ставок по начислению' @ 3,3 say 'начисления кв.платы' @ 3,29 get kwp_l PICTURE '##.##' @ 4,3 SAY 'начисления телефона' @ 4,29 get tl_l PICTURE '##.##' @ 5,3 say 'начисления радио' @ 5,29 get rd_l PICTURE '##.##' @ 6,3 say 'начисления ком. услуг' @ 6,29 get k_l_l PICTURE '##.##' @ 7,3 say 'начисления Гор.воды' @ 7,29 get gw_l PICTURE '##.##' @ 8,3 say 'начисления Хол.воды' @ 8,29 get xw_l PICTURE '##.##' @ 9,3 say 'начисления отопления' @ 9,29 get ot_l PICTURE '##.##' @ 10,3 say 'начисления э\энергии' @ 10,29 get el_l read kwar_ta=kwp_l telef=tl_l radio=rd_l kom_ysl=k_l_l gor_water=gw_l xol_water=xw_l otopl_e=ot_l electr_vo=el_l clear SELE a @ 2,2 SAY 'Улица - '+yl @ 3,2 SAY 'Дом '+dom @ 4,2 SAY 'Кол-во квартир - '+LTRIM(STR(kl_kvartir(0))) WAIT 'Установить всем жильцам (Y/N) ' TO Y SET ORDER TO 0 d=dom y=yl k=kw_ra IF LASTKEY()=89.OR.LASTKEY()=121.OR.LASTKEY()=141 SET FILTER TO d=dom.AND.y=yl SCAN REPLACE g.kwp_l WITH kwar_ta,g.tl_l WITH telef,g.rd_l WITH radio,; g.k_l_l WITH kom_ysl,g.gw_l WITH gor_water,g.xw_l WITH xol_water,; g.ot_l WITH otopl_e,g.el_l WITH electr_vo ENDSCAN ELSE SET FILTER TO d=dom.AND.y=yl.AND.k=kw_ra SCAN REPLACE g.kwp_l WITH kwar_ta,g.tl_l WITH telef,g.rd_l WITH radio,; g.k_l_l WITH kom_ysl,g.gw_l WITH gor_water,g.xw_l WITH xol_water,; g.ot_l WITH otopl_e,g.el_l WITH electr_vo ENDSCAN ENDIF RELEASE WINDOWS M_ZAR SET FILTER TO @ 10,27 CLEAR TO 20,50 GO _REC =POS_CH1() SHOW GETS RETURN FUNCTION kl_kvartir && Количество квартир para k k=0 d=dom y=yl R=RECNO() set filter to d=dom.AND.y=yl COUNT TO k set filter to GO R RETURN k FUNCTION TARIFS && Окно для выбора ставок по оплате sele a _REC=RECNO() sele f DEFINE WINDOW m_zar1 FROM 5,12 TO 20,66 COLOR SCHEME 12 DEFINE MENU TARIFS DEFINE PAD vibor OF TARIFS PROMPT 'Выбрать' DEFINE PAD apend OF TARIFS PROMPT 'Добавить' DEFINE PAD exit OF TARIFS PROMPT 'Выйти' DEFINE PAD DEF OF TARIFS PROMPT 'Установить норматив' ON PAD vibor OF TARIFS ACTIVATE POPUP TAR_S ON SELECTION PAD apend OF TARIFS DO INS_ST WITH PROMPT() ON SELECTION PAD exit OF TARIFS DO INS_ST WITH PROMPT() ON PAD DEF OF TARIFS ACTIVATE POPUP DEF1 DEFINE POPUP vib_komy FROM 7,12 COLOR SCHEME 1 DEFINE BAR 1 OF vib_komy PROMPT 'Установить всем жильцам дома' DEFINE BAR 2 OF vib_komy PROMPT 'Установить данному жильцу' ON SELECTION POPUP vib_komy DO v_st1 WITH BAR(),RECNO() DEFINE POPUP DEF1 FROM 1,20 DEFINE BAR 1 OF DEF1 PROMPT 'Установить всем жильцам дома' DEFINE BAR 2 OF DEF1 PROMPT 'Установить данному жильцу' ON SELECTION POPUP DEF1 DO v_st2 WITH BAR() DEFINE POPUP TAR_S FROM 1,1 TITLE; 'Описание тарифа--------|-Ставка-|-Расчен на-|'; PROMPT FIELD info+'|'+STR(st_ka,8,2)+'|'+k_info ON SELECTION POPUP TAR_S ACTIVATE POPUP vib_komy DO CASE CASE tar_s=1 SET FILTER TO k_ch=.F. vib_stavok='KWP_L' yslyga='Квартплата' ACTIVATE WINDOW M_ZAR1 WAIT 'Квартплата' WIND NOWAIT ACTIVATE MENU TARIFS @ 10,28 say LTRIM(STR(kw1(0),5,2)) SET FILTER TO CASE tar_s=2 SET FILTER TO k_ch=.T. vib_stavok='GW_L' WAIT 'Горячая вода' WIND NOWAIT ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS @ 11,28 SAY LTRIM(STR(GW1(0),5,2)) SET FILTER TO CASE tar_s=3 SET FILTER TO k_ch=.T. vib_stavok='XW_L' WAIT 'Холодная вода' WIND NOWAIT ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS @ 12,28 SAY LTRIM(STR(XW1(0),5,2)) SET FILTER TO CASE tar_s=4 SET FILTER TO k_ch=.T. vib_stavok='K_L_L' WAIT 'Коммунальные услуги' WIND NOWAIT ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS @ 13,28 SAY LTRIM(STR(KS1(0),5,2)) SET FILTER TO CASE tar_s=5 SET FILTER TO k_ch=.F. vib_stavok='OT_L' WAIT 'Отопление' WIND NOWAIT ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS @ 14,28 SAY LTRIM(STR(OT1(0),5,2)) SET FILTER TO CASE tar_s=6 SET FILTER TO k_ch=.F. vib_stavok='EL_L' WAIT 'Электроэнергия' WIND NOWAIT ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS @ 15,28 SAY LTRIM(STR(ELC1(0),5,2)) SET FILTER TO CASE tar_s=7 SET FILTER TO k_ch=.T. vib_stavok='TL_L' WAIT 'Телефон' WIND NOWAIT ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS @ 16,28 SAY LTRIM(STR(TL3(0),5,2)) SET FILTER TO CASE tar_s=8 SET FILTER TO k_ch=.T. vib_stavok='RD_L' WAIT 'Радио' WIND NOWAIT ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS @ 17,28 say LTRIM(STR(RD3(0),5,2)) SET FILTER TO ENDCASE RETURN FUNCTION INS_ST && Выбор пунктов меню PARAMETERS mprompt DO CASE CASE mprompt='Добавить' SELE F SCATTER MEMVAR BLANK @ 2,2 SAY 'Введите описание тарифа' @ 3,2 get m.info @ 4,2 SAY 'Ставка - 'get m.st_ka PICTURE '##.##' @ 6,2 GET ras_on FUNCTION '*R На 1 кв.метр;На 1-го чел' VALID kv_chel() defa 1 COLOR SCHEME 16 @ 10,2 GET ras_on1 FUNCTION '*H Сохранить;Отказ' VALID kv_chel1() defa 1; COLOR SCHEME 15 size 1,10,4 READ CYCLE CASE mprompt='Выйти' DEACTIVATE WINDOW m_zar1 DEACTIVATE MENU SELE A ENDCASE RETURN FUNCTION kv_chel do case CASE ras_on=1 m.k_ch=.f. CASE ras_on=2 m.k_ch=.t. endcase FUNCTION kv_chel1 DO CASE CASE ras_on1=1 PAR='Добавить' IF m.k_ch=.t. m.k_info='На 1-го чел.' ELSE m.k_info='На 1 кв.метр' ENDIF APPEND BLANK GATHER MEMVAR DO ins_st WITH PAR CASE ras_on1=2 CLEAR read clear ENDCASE RETURN FUNCTION v_st1 PARAMETER B,N HIDE POPUP TAR_S HIDE POPUP vib_komy SELE a r=RECNO() y=yl d=dom k=kw_ra ORD_A=ORDER() SET ORDER TO 0 SELE f DO CASE CASE B=1 GO N ST=ST_KA SELE A GO r SCAN FOR y=yl.AND.d=dom sele G REPLACE &VIB_STAVOK WITH ST SELE a ENDSCAN CASE B=2 GO N ST=ST_KA SELE A GO r SCAN FOR y=yl.AND.d=dom.AND.k=kw_ra sele G REPLACE &VIB_STAVOK WITH ST SELE a ENDSCAN ENDCASE SELE A SET ORDER TO &ORD_A GO r DEACTIVATE WINDOW m_zar1 DEACTIVATE MENU RETURN FUNCTION v_st2 PARAMETER B HIDE POPUP DEF1 SELE A GO _REC ST=0 y=yl d=dom k=kw_ra ORD_A=ORDER() SET ORDER TO 0 DO CASE CASE B=1 SCAN FOR y=yl.AND.d=dom sele G REPLACE &VIB_STAVOK WITH ST SELE a ENDSCAN CASE B=2 SCAN FOR y=yl.AND.d=dom.AND.k=kw_ra sele G REPLACE &VIB_STAVOK WITH ST SELE a ENDSCAN ENDCASE SELE A SET ORDER TO &ORD_A GO _REC DEACTIVATE WINDOW m_zar1 DEACTIVATE MENU RETURN ** Отображение SAY стоимости услуг ** **************************************************************************** ************** FUNCTION kw1 PARAMETER ST IF !EMPTY(g.kwp_l) ST=g.kwp_l ELSE ST=_kv_pl ENDIF RETURN ST FUNCTION GW1 PARAMETER ST IF !EMPTY(g.gw_l) ST=g.gw_l ELSE ST=_gor_w ENDIF RETURN ST FUNCTION xw1 PARAMETER ST IF !EMPTY(g.xw_l) ST=g.xw_l ELSE ST=_xol_w ENDIF RETURN ST FUNCTION ks1 PARAMETER ST IF !EMPTY(g.k_l_l) ST=g.k_l_l ELSE ST=_kom ENDIF RETURN ST FUNCTION ot1 PARAMETER ST IF !EMPTY(g.ot_l) ST=g.ot_l ELSE ST=_otopl ENDIF RETURN ST FUNCTION elc1 PARAMETER ST IF !EMPTY(g.el_l) ST=g.el_l ELSE ST=_elek ENDIF RETURN ST FUNCTION tl3 PARAMETER ST IF !EMPTY(g.tl_l) ST=g.tl_l ELSE ST=_tel ENDIF RETURN ST FUNCTION rd3 PARAMETER ST IF !EMPTY(g.rd_l) ST=g.rd_l ELSE ST=_rad ENDIF RETURN ST **************************************************************************** ******* ** Функции выбора индикаторов (GET[]) ** **************************************************************************** ******* FUNCTION KW REPLACE KW_L WITH kw FUNCTION GW REPLACE G_W_L WITH gw FUNCTION XW REPLACE X_W_L WITH xw FUNCTION KS REPLACE K_YS_L WITH ks FUNCTION OT REPLACE OTOP_L WITH ot FUNCTION TL DO CASE CASE tl=.T. DO TL1 WITH OR_R,LGOT,RECNO(),ORDER() CASE tl=.F. REPLACE TEL_L WITH tl ENDCASE FUNCTION RD DO CASE CASE rd=.T. DO RD1 WITH OR_R,LGOT,RECNO(),ORDER() CASE rd=.F. REPLACE RAD_L WITH rd ENDCASE FUNCTION ELC REPLACE EL_C_L WITH elc **************************************************************************** ******* ** Выбор начисления телефона и радио ** **************************************************************************** ******* FUNCTION TL1 PARA OR,LG,R,ORD SELE a *GO _REC Y=YL D=DOM KV=KW_RA LOCATE FOR Y=YL AND D=DOM AND KV=KW_RA AND OR_R=1 IF FOUND().AND.EMPTY(tel) tl=.F. GO R SHOW GET tl RETURN ELSE DO CASE CASE OR=1.AND.LG=.T. SET ORDER TO ADRR SCAN FOR Y=YL AND D=DOM AND KV=KW_RA REPLACE TEL_L WITH .F. ENDSCAN GO R REPLACE TEL_L WITH .T. SET ORDER TO &ORD RETURN CASE OR=1.AND.LG=.F. GO R REPLACE TEL_L WITH .T. RETURN CASE LG=.T..AND.OR=0 SCAN FOR Y=YL AND D=DOM AND KV=KW_RA AND LGOT=.T. IF TEL_L=.T. TL=.F. SHOW GET TL GO R RETURN ENDIF ENDSCAN GO R REPLACE TEL_L WITH tl ENDCASE ENDIF RETURN FUNCTION RD1 && Выбор начисления радио PARA OR,LG,R,ORD SELE a Y=YL D=DOM KV=KW_RA DO CASE CASE OR=1.AND.LG=.T. SET ORDER TO ADRR SCAN FOR Y=YL AND D=DOM AND KV=KW_RA REPLACE RAD_L WITH .F. ENDSCAN GO R REPLACE RAD_L WITH .T. SET ORDER TO &ORD RETURN CASE OR=1.AND.LG=.F. GO R REPLACE RAD_L WITH .T. RETURN CASE LG=.T..AND.OR=0 SCAN FOR Y=YL AND D=DOM AND KV=KW_RA AND LGOT=.T. IF RAD_L=.T. rd=.F. SHOW GET rd GO R RETURN ENDIF ENDSCAN GO R REPLACE RAD_L WITH rd ENDCASE RETURN **************************************************************************** ******* FUNCTION kol && Функция кол-ва жильцов (SAY) PARAMETERS k _REC=RECNO() k=0 y_l=yl d=dom kv=kw_ra scan for yl=y_l.and.dom=d.and.kw_ra=kv k=k+1 endscan go _REC RETURN k FUNCTION KL_l && Функция кол-ва льготников (SAY) parameters k _REC=RECNO() y=0 y_l=yl d=dom kv=kw_ra scan for yl=y_l.and.dom=d.and.kw_ra=kv.and.lgot=.t. k=k+1 endscan go _REC RETURN k FUNCTION vib1_7 do case case all_l=1 clear read case all_l=2 CLEAR READ DEACTIVATE WINDOW INS DO RAS endcase RETURN ** Конец Процедуре Квартиросъемщики (Постоянная Часть) ** **************************************************************************** ******* ** Функция сохранения норм в файле m_zar.mem ** **************************************************************************** ******* FUNCTION cf do case case c=1 DEACTIVATE WINDOW m_zar SAVE TO m_zar ALL LIKE _* case c=2 clear read RELEASE windows m_zar endcase RETURN **************************************************************************** ******* ** Процедура помощи по F1 ** **************************************************************************** ******* PROCEDURE HELP PARAMETERS k DEFINE WINDOW HELP FROM 4,7 TO 20,73 shadow; TITLE 'PgUp,PgDn-листание' FOOTER 'Esc-выход без сохранения,Ctrl+W-c сохранением'; color scheme 12 IF k#0 GO K IN i MODIFY MEMO i.HLP WINDOW HELP noedit ENDIF release WINDOWS HELP RETURN **************************************************************************** ********* Процедура выхода ** **************************************************************************** ******* PROCEDURE quit DEFINE WINDOW QUIT FROM 9,30 TO 14,50 ACTIVATE WINDOW QUIT @ 1,4 SAY 'Вы уверены?' @ 3,2 GET q FUNCTION '*HN Да;Нет;DOS' VALID qt(); DEFAULT 2 COLOR ,,,,gr+/b,w+/n,r+/b,,n+/w,w/gr+ READ CYCLE RELEASE WINDOW quit RETURN FUNCTION qt && Функция выхода DO CASE CASE q=1 CLEAR WINDOWS SAVE TO m_zar ALL LIKE _* ON KEY ! DEL TAB*.TXT CLOSE DATA CLEAR MEMORY CLEAR CANCEL CASE q=2 CLEAR READ RELEASE WINDOWS QUIT CASE q=3 SAVE TO m_zar ALL LIKE _* ! DEL TAB*.TXT QUIT ENDCASE RETURN **************************************************************************** ******* ** Процедура Упаковки ** **************************************************************************** ******* PROCEDURE SERV SET ORDER TO TAB SET DELETE OFF SCAN FOR DELETE() SELECT g IF SEEK(a.tab) DELETE FOR a.tab=g.tab ENDIF SELE a ENDSCAN SET ORDER TO ADRR SCAN FOR DELETE() y=yl d=dom kv=kw_ra r=recno() fm=fam tb=tab SET DELETE ON LOCATE FOR yl=y.and.dom=d.and.kw_ra=kv.AND.or_r=0 IF FOUND() n_ins=RECNO() LOCATE FOR yl=y.and.dom=d.and.kw_ra=kv.and.or_r=1 IF FOUND()=.F. ACTIVATE WINDOW vib @ 0,1 SAY 'За квартиру по адресу:' @ 1,2 say alltrim(y)+' '+'Дом-'+ALLTRIM(d)+' '+'Кв-'+ALLTRIM(kv) @ 2,3 SAY 'Не начисляется плата' @ 3,2 say 'Платил-'+ALLTRIM(fm)+' '+'Таб-'+ALLTRIM(STR(tb)) @ 4,1 GET D_IN FUNCTION '*H Удалить всех;Изменить;Восстановить' valid d_in() defa READ CYCLE DEACTIVATE WINDOW vib ENDIF ENDIF GO R SET DELETE OFF ENDSCAN SELECT g PACK SELE a PACK SET DELETE ON DO P_INDEX RETURN FUNCTION d_in && Выбор кнопок в процедуре Упаковки DO CASE CASE d_in=1 SET DELETE OFF SCAN FOR yl=y.and.dom=d.and.kw_ra=kv DELETE ENDSCAN SET DELETE ON CASE d_in=2 GO n_ins DO INS WITH 2 IN ADD_DEL CASE d_in=3 SET DELETE OFF GO r RECALL SET FILTER TO yl=y.and.dom=d.and.kw_ra=kv COUNT TO kol GO TOP SCAN REPLACE kol_vo WITH kol ENDSCAN SET FILTER TO sele g SEEK(a.tab) RECALL SET DELETE ON ENDCASE RETURN **************************************************************************** ******* ** Переиндексация ** **************************************************************************** ******* PROCEDURE P_INDEX CLOSE DATA !DEL *.CDX DO OPEN RETURN **************************************************************************** ******* ** Процедура поиска ** **************************************************************************** ******* PROCEDURE poisk _REC=RECNO() && Запоминается номер текущей записи DO CASE CASE PROMPT()="Отмена сортировки" && Если "Отмена" SET ORDER TO 0 && Отказ от главного индекса CASE PROMPT()='По фамилии' SET ORDER TO fam ACTIVATE WINDOW poisk @ 0,0 GET a DEFA SPAC(25) && Задание фамилии @ 1,2 SAY 'Соблюдайте РЕГИСТР' READ a=ALLTRIM(a) && Удаление пробелов d=a CASE PROMPT()='По табелю' set order to tab ACTIVATE WINDOW poisk @ 0,0 GET a PICTURE '9999' DEFAULT 0&& Задание табеля READ d=str(a,4) && Сохранить запрос CASE PROMPT()='По адресу' DO po_adr ENDCASE DEACTIVATE WINDOW poisk IF BAR()#4.AND.!EMPTY(a).AND.!SEEK(a) * Если Поиск,'a' не пуста и поиск неудачный WAIT 'Поиск '+PROMPT()+':'+d+' НЕУДАЧНЫЙ' WINDOW GO _REC && Выдается сообщение и возврат на предыдущую запись ELSE _REC=RECNO() GO _REC IF WONTOP()='INS' @ 10,27 CLEAR TO 20,50 =POS_CH1() SHOW GETS ENDIF ENDIF set order to adrr DEACTIVATE POPUP RETURN FUNCTION po_adr && Поиск по адресу DEFINE POPUP YL FROM 1,0 n=recno() m=1 br=1 d_ins=1 DIMENSION yl_za(100,1) go top i=1 yl_za(i,1)=yl DO WHILE !EOF() DEFINE BAR (br) OF YL PROMPT yl_za(i,1) IF yl=yl_za(i,1) skip loop ENDIF m=m+1 i=i+1 yl_za(i,1)=yl br=br+1 ENDDO DIMENSION yl_za(m,1) ON SELECTION POPUP YL DO YLIZ WITH PROMPT() go n SCATTER FIELDS yl,dom,kw_ra MEMVAR BLANK ACTIVATE WINDOW poisk @ 0,0 GET m.yl WHEN yliz_s() @ 1,2 SAY 'Дом ' GET m.dom @ 1,12 SAY 'Кв-ра ' GET m.kw_ra READ COLOR ,n/w DO CASE CASE !EMPTY(m.yl).AND.EMPTY(m.dom).AND.EMPTY(m.kw_ra) LOCATE FOR m.yl=a.yl CASE !EMPTY(m.yl).AND.!EMPTY(m.dom).AND.EMPTY(m.kw_ra) LOCATE FOR m.yl=a.yl.AND.m.dom=a.dom CASE !EMPTY(m.yl).AND.!EMPTY(m.dom).AND.!EMPTY(m.kw_ra) LOCATE FOR m.yl=a.yl.AND.m.dom=a.dom.AND.m.kw_ra=a.kw_ra.AND.a.or_r=1 ENDCASE IF FOUND() DEACTIVATE WINDOW poisk _REC=RECNO() GO _REC IF WONTOP()='INS' @ 10,27 CLEAR TO 20,50 =POS_CH1() SHOW GETS ENDIF ELSE GO n ENDIF **************************************************************************** ******* ** Формирование квитанции ** **************************************************************************** ******* FUNCTION PRINT1 ON KEY LABEL F1 DO HELP WITH 7 SET ALTERNATE TO tab T='tab'+'.'+'txt' DIMENSION NACH(12,1) DIMENSION LG(9) STORE 0 TO LG(1),LG(2),LG(3),LG(4),LG(5),LG(6),LG(7),LG(8),LG(9) SET ALTERNATE ON SET CONSOLE OFF r=RECNO() y=yl d=dom kv=kw_ra PL=0 L=0 scan for yl=y.and.dom=d.and.kw_ra=kv.and.c.yl=y.and.c.dom=d.and.c.kw_ra=kv IF OR_R=1 FM=FAM OS=OST_K TB=TAB KV_MET=KV_M NACH(1)=C.KW_PL NACH(2)=C.G_W NACH(3)=C.X_W NACH(4)=C.K_YSL NACH(5)=C.OTOPL NACH(6)=C.RAD_R NACH(7)=C.TEL_R NACH(8)=C.EL_C NACH(9)=C.ITOG_N NACH(10)=C.ITOG NACH(11)=OPL_TA endif IF lgot=.t. LG(1)=LG(1)+C.KW_PLL LG(2)=LG(2)+C.G_WL LG(3)=LG(3)+C.X_WL LG(4)=LG(4)+C.K_YSLL LG(5)=LG(5)+C.OTOPLL LG(6)=LG(6)+C.RAD_RL LG(7)=LG(7)+C.TEL_RL LG(8)=LG(8)+C.EL_CL LG(9)=LG(9)+C.ITOG_L L=L+1 ENDIF PL=PL+1 ENDSCAN GO R ? 'КВИТАНЦИЯ ПО ОПЛАТЕ КВАРТИРЫ ЗА ',MES(mess) ? ? FM AT(4) ? 'Табель - ' AT(4),TB PICTURE('9999'),' Дата оплаты ',D_OPL FUNCTION('T') ? 'Кол-во жильцов ' at(4),pl picture('99'),' Площадь ',KV_MET PICTURE('###.##') ? 'Льготников ' at(4),l picture('99') ? ? REPLICATE('-',69) ? '|','Сальдо ','|','кв.плата ','|','гор.вода ','|','ком.услуги ','|','радио ','|','телефон ','|','Начислено ','|' ? '|',' Пени ','|','излишки ','|','хол.вода ','|','отопление ','|',' ','|','э\энергия','|',' ','|' ? REPLICATE('-',69) ? OS PICTURE ('####.##') AT(1) &&Остаток ?? NACH(1) PICTURE ('###.##') AT(10) && кв.плата ?? NACH(2) PICTURE ('###.##') AT(19) && гор.вода ?? NACH(4) PICTURE ('###.##') AT(30) && ком.услуги ?? NACH(6) PICTURE ('##.##') AT(40) && радио ?? NACH(7) PICTURE ('###.##') AT(50) && телефон ? NACH(3) PICTURE ('###.##') AT(19) && хол.вода ?? NACH(5) PICTURE ('###.##') AT(30) && отопление ?? NACH(8) PICTURE ('###.##') AT(50) && электричество ?? NACH(9) PICTURE ('###.##') AT(60) && итог IF L>0 ? 'Льгота' ? LG(1) PICTURE ('###.##') AT(10) && кв.плата ?? LG(2) PICTURE ('###.##') AT(19) && гор.вода ?? LG(4) PICTURE ('###.##') AT(30) && ком.услуги ?? LG(6) PICTURE ('##.##') AT(40) && радио ?? LG(7) PICTURE ('###.##') AT(50) && телефон ? LG(3) PICTURE ('###.##') AT(19) && хол.вода ?? LG(5) PICTURE ('###.##') AT(30) && отопление ?? LG(8) PICTURE ('###.##') AT(50) && электричество ?? LG(9) PICTURE ('###.##') AT(60) && итого STORE 0 TO LG(1),LG(2),LG(3),LG(4),LG(5),LG(6),LG(7),LG(8),LG(9) ENDIF ? ? REPLICATE('-',30),'ИТОГО НАЧИСЛЕНО - ',NACH(10) picture('####.##') ? 'ОПЛАЧЕНО В КАССУ - ' AT(30),NACH(11) PICTURE('####.##') ? 'ОСТАТОК ' AT(30),OS PICTURE('####.##') ? 'Kассир ','___________',' / ' ?? _pod PICTURE(REPLICATE('x',AT(' ',_pod)-1)),' /' SET ALTERNATE OFF SET ALTERNATE TO SET CONSOLE ON MODIFY COMMAND EVALUATE('T') WINDOW vedom ACTIVATE WINDOW vib @ 2,5 SAY 'Р а с п е ч а т а т ь ?' @ 0,0 FILL TO 8,43 COLOR W+/R @ 5,6 GET pr FUNCTION '*H Да;Нет' VALID print4() DEFA 2 SIZE 1,6,4; COLOR ,,,,w+/n,w+/n,w+/n,,W+/R, READ DEACTIVATE WINDOW vib RETURN FUNCTION print4 && Печать квитанции DO CASE CASE pr=1 SET HEADING OFF IF PRINTSTATUS() TYPE (T) TO PRINT ELSE WAIT 'Подготовьте принтер' WINDOW ENDIF CASE pr=2 CLEAR READ ENDCASE ON KEY LABEL F1 DO HELP WITH 1 RETURN **************************************************************************** ******* ** Функция печати отчетов ** **************************************************************************** ******* PROCEDURE print3 && Пункт Меню <Печать> PARAMETER vv,lk IF RIGHT(vv,1)#':'.OR.RIGHT(vv,1)#']' DO CASE CASE lk=13 MODIFY FILE (vv) WINDOW vedom CASE lk=32 SET HEADING OFF IF PRINTSTATUS() TYPE (vv) TO PRINT ELSE WAIT 'Подготовьте принтер' WINDOW ENDIF ENDCASE ENDIF RETURN **************************************************************************** ******* ** Функции к дополнению (add_del.prg) ** **************************************************************************** ******* FUNCTION POS_CH2 && SAY - Объекты @ 0,1 to 7,55 double @ 1,2 say 'Фамилия ' COLOR SCHEME 12 @ 2,2 say 'Табель -' COLOR SCHEME 12 @ 2,20 say 'Телефон ' COLOR SCHEME 12 @ 3,2 say 'Адрес: ' @ 3,26 say 'Дом ' @ 3,35 say 'Кв-ра ' @ 4,2 say 'Площадь ' COLOR SCHEME 12 @ 6,3 SAY 'ДАННЫЕ СЧЕТЧИКА:' COLOR SCHEME 16 @ 5,20 SAY 'Старое значение' @ 6,20 SAY 'Новое значение' FUNCTION YLIZ1 && Функция выхода из поля m.yl(выбор улицы) HIDE POPUP YL FUNCTION yliz_s && Меню для выбора улицы =CAPSLOCK(.F.) IF RECCOUNT()>0.and.d_ins=1 ACTIVATE POPUP YL ENDIF FUNCTION YLIZ && Выбор улицы PARA mprompt m.yl=mprompt show get m.yl DEACTIVATE POPUP YL RETURN FUNCTION LG1 && Меню для выбора льготы SELE D IF RECCOUNT()>0 DEFINE POPUP LGOT FROM 2,27 PROMPT FIELD LTRIM(STR(N_LG))+' | '+INFO ON SELECTION POPUP LGOT DO LG_T WITH RECNO() ACTIVATE POPUP LGOT ENDIF FUNCTION LG_T && Выбор кода льготы PARA R N=RECNO() SELE D GO R m.n_lg=n_lg sele a show get m.n_lg DEACTIVATE POPUP LGOT FUNCTION vib_lg && Выбор льготы (дополнение льготы) DO CASE CASE lg_ta=.t. m.lgot=.T. activate window hp @ 0,0 to 4,0 double @ 0,26 to 5,26 double @ 1,2 say 'Укажите группу' @ 1,18 get m.n_lg picture '99' WHEN LG1() default 2 @ 3,2 say 'N удостоверения' @ 3,18 get m.n_yd read color scheme 7 deactivate window hp IF m.n_lg=0 lg_ta=.f. m.lgot=.f. show get lg_ta SHOW GETS else LOCATE FOR m.n_lg=d.n_lg IF FOUND()=.F. SELE d APPEND BLANK REPLACE N_LG WITH m.n_lg SELE a ENDIF @ 8,30 say 'Ввод ставок по льготам' @ 9,30 SAY 'КОД - ' GET m.n_lg disable SHOW GETS endif CASE lg_ta=.f. m.lgot=.F. SHOW GETS ENDCASE RETURN **************************************************************************** ******* ** Выбор начислений на услуги ** **************************************************************************** ******* FUNCTION KW_INS M.KWP_L=KW FUNCTION GW_INS M.G_W_L=GW FUNCTION XW_INS M.X_W_L=XW FUNCTION KS_INS M.K_YS_L=KS FUNCTION ELC_INS M.EL_C_L=ELC FUNCTION OT_INS M.OTOP_L=OT **************************************************************************** ******* FUNCTION TL2 && Определение выбора телефона IF or1=2 m.tel=0 else m.tel_l=.t. tl=.t. endif RETURN FUNCTION O_R && Недопущение повтора плательщика DO CASE CASE or1=1 r=recno() y_l=LTRIM(m.yl) d=LTRIM(m.dom) k=LTRIM(m.kw_ra) locate for yl=y_l.and.dom=d.and.kw_ra=k.and.or_r=1 if found() if tab#m.tab activate window vib @ 0,0 say 'Двое за 1 квартиру платить не могут' color scheme 12 @ 2,1 say 'За квартиру платит:' @ 3,2 say fam+ 'Таб.'+STR(tab,4) READ deactivate window vib if red=2 go r ENDIF m.or_r=0 or1=0 show get or1,1 RETURN .F. ENDIF endif if red=2 go r ENDIF deactivate window vib m.or_r=1 @ 8,5 SAY 'ВЫБЕРИТЕ УСЛУГИ' SHOW GETS case or1=0 m.or_r=0 @ 8,0 CLEAR TO 23,29 SHOW GETS ENDCASE RETURN FUNCTION unic && Недопущение повтора табеля do case case red=1 SELE a locate for tab=m.tab if found() activate window vib @ 0,1 say 'Ошибка ввода табельного номера' color scheme 12 @ 2,1 say 'Такая запись в базе уже есть' @ 3,2 say fam+STR(tab,4) READ deactivate window vib RETURN .F. ENDIF ENDCASE deactivate window vib RETURN PROCEDURE ad_in && Процедура Дополнения/Изменения m.fam=LTRIM(m.fam) m.yl=LTRIM(m.yl) m.dom=LTRIM(m.dom) m.kw_ra=LTRIM(m.kw_ra) k_v=m.kv_m IF m.or_r=0 m.tel=0 m.tel_l=.f. k_v=0 ENDIF IF m.or_r=1.and.!empty(m.tel) m.tel_l=.t. tl=.t. ELSE m.tel_l=.f. ENDIF DO CASE CASE pod=1 DO CASE CASE red=1 SELE a GO top APPEND BLANK GATHER MEMVAR t=tab r=RECNO() _REC=RECNO() y_l=yl d=dom k=kw_ra skip LOCATE ALL FOR y_l=yl.and.d=dom.and.k=kw_ra DO CASE CASE FOUND() IF recno()=r REPLACE kol_vo WITH 1 ELSE store kol_vo to k_l_vo GO r REPLACE kol_vo WITH k_l_vo go 1 SCAN for y_l=yl.and.d=dom.and.k=kw_ra REPLACE kol_vo WITH kol_vo + 1 IF or_r=1 k_v=kv_m ENDIF ENDSCAN ENDIF ENDCASE GO r REPLACE kv_m WITH k_v SELE g USE TABLE_R LOCATE ALL FOR tab=t IF FOUND()=.F. go top APPEND BLANK REPLACE g.tab WITH a.tab endif R_G=RECNO() SELE a go r LOCATE ALL FOR y_l=yl.and.d=dom.and.k=kw_ra.AND.or_r=1 IF FOUND() SELE G GO R_G KP=KWP_L G=GW_L X=XW_L KY=K_L_L O=OT_L R_D=RD_L T_L=TL_L E=EL_L SELE a GO r SELE g REPLACE g.kwp_l WITH KP,g.tl_l WITH T_L,g.rd_l WITH R_D,; g.gw_l WITH G,g.xw_l WITH X,g.k_l_l WITH KY,g.ot_l WITH O,g.el_l WITH E ENDIF SELE a SCATTER MEMVAR BLANK kw=.F. gw=.F. xw=.F. ks=.F. ot=.F. elc=.F. tl=.F. rd=.F. lg_ta=.F. or1=0 SHOW GETS _CUROBJ=1 CASE red=2 GO _REC GATHER MEMVAR IF yl_ins=yl.AND.dom_ins=dom.AND.k_ins=kw_ra RETURN ELSE y=yl d=dom k=kw_ra SET FILTER TO y=yl.AND.d=dom.AND.k=kw_ra COUNT TO kol SCAN REPLACE kol_vo WITH kol ENDSCAN GO TOP SET FILTER TO yl_ins=yl.AND.dom_ins=dom.AND.k_ins=kw_ra COUNT TO kol SCAN REPLACE kol_vo WITH kol ENDSCAN SET FILTER TO GO _REC ENDIF ENDCASE CASE pod=2 CLEAR READ CASE pod=3 DO DEL ENDCASE RETURN PROCEDURE del && Удаление записи в БАЗЕ RABOT n=RECNO() SET DELETE OFF IF DELETE() RETURN ENDIF GATHER MEMVAR y_l=yl d=dom k=kw_ra GO TOP SET FILTER TO y_l=yl.and.d=dom.and.k=kw_ra COUNT TO kol GO TOP kol=kol-1 SCAN REPLACE kol_vo WITH kol ENDSCAN SET FILTER TO GO n DELETE SET DELETE ON SKIP IF EOF()=.T. GO TOP ENDIF IF WONTOP()='INS' @ 10,27 CLEAR TO 20,50 =POS_CH1() SHOW GETS ENDIF RETURN **************************************************************************** ******* ** Функции к дополнению по льготам (ADD_DEL.PRG) ** **************************************************************************** ******* FUNCTION LG_INS DO CASE CASE LG_INS=1 m.info=LTRIM(m.info) LOCATE FOR m.n_lg=d.n_lg IF FOUND() GATHER MEMVAR SCATTER MEMVAR BLANK SHOW GETS ELSE APPEND BLANK GATHER MEMVAR SCATTER MEMVAR BLANK SHOW GETS ENDIF CASE LG_INS=2 CLEAR READ CASE LG_INS=3 GATHER MEMVAR DELETE PACK SCATTER MEMVAR BLANK SHOW GETS ENDCASE RETURN FUNCTION UNIC_LG m=m.n_lg LOCATE FOR m.n_lg=d.n_lg IF FOUND() SCATTER MEMVAR SHOW GETS ELSE SCATTER MEMVAR BLANK m.n_lg=m SHOW GETS ENDIF RETURN **************************************************************************** ******* ** Функции К Базам (Bazes.Prg) ** **************************************************************************** ******* FUNCTION ins2 && Выбор Дополнения, при пустой БАЗЕ DO CASE CASE ins1=1 DO INS WITH 1 IN ADD_DEL CASE ins1=2 CLEAR READ ENDCASE RETURN PROCEDURE NACH && Функция отображения начислений @ 0,31 clear to 23,79 @ 3,31 to 23,78 double set color of scheme 13 to N/W,GR/W, N/W, N/W,Gr/W,Gr/W,Gr/W,Gr/W,Gr/W,Gr/W @ 4,32 fill to 22,77 color scheme 13 @ 3,45 say 'Произведенные начисления' @ 4,34 say 'Фамилия' color scheme 13 @ 4,46 get fam disable color scheme 13 @ 5,34 say 'Табель' color scheme 13 @ 5,45 get tab disable color scheme 13 @ 6,45 get kv_m picture '###.##' disable color scheme 13 @ 6,34 say 'Площадь'color scheme 13 @ 7,34 say 'Категория' color scheme 13 @ 7,45 get d.info disable color scheme 13 @ 8,34 say 'Кол-во жильцов - '+ltrim(str(kol(0))) color scheme 13 @ 9,34 say 'Из них льготников - ' +ltrim(str(kl_l(0))) COLOR SCHEME 12 @ 7,60 say 'удостов. N'color scheme 13 @ 7,68 get n_yd disable color scheme 13 @ 10,58 SAY 'Сумма' COLOR B/W,,,,,,,,, @ 10,67 SAY 'На одного' COLOR B/W,,,,,,,,, @ 11,35 say 'Сальдо'color scheme 13 @ 11,47 SAY ost_k color r/W,,,,,,,,, @ 12,35 say 'Кв-плата'color scheme 13 @ 12,47 get c.kw_pl disable color scheme 13 @ 12,58 say LTRIM(STR(c.sum_kw,6,2)) color r/W,,,,,,,,, @ 13,35 say 'Гор.вода'color scheme 13 @ 13,47 get c.g_w disable color scheme 13 @ 13,58 say ltrim(str(c.sum_gw,6,2)) color r/W,,,,,,,,, @ 14,35 say 'Хол.вода'color scheme 13 @ 14,47 get c.x_w disable color scheme 13 @ 14,58 say ltrim(str(c.sum_xw,6,2)) color r/W,,,,,,,,, @ 15,35 say 'Ком.услуги'color scheme 13 @ 15,47 get c.k_ysl disable color scheme 13 @ 15,58 say ltrim(str(c.sum_kysl,6,2)) color r/W,,,,,,,,, @ 16,35 say 'Отопление'color scheme 13 @ 16,47 get c.otopl disable color scheme 13 @ 16,58 say ltrim(str(c.sum_ot,6,2)) color r/W,,,,,,,,, @ 17,35 say 'Радио'color scheme 13 @ 17,47 get c.rad_r disable color scheme 13 @ 17,58 say ltrim(str(c.sum_rd,6,2)) color r/W,,,,,,,,, @ 18,35 say 'Телефон'color scheme 13 @ 18,47 get c.tel_r disable color scheme 13 @ 18,58 say ltrim(str(c.sum_tl,6,2)) color r/W,,,,,,,,, @ 19,35 say 'Э-энергия' color scheme 13 @ 19,47 get c.el_c disable color scheme 13 @ 20,35 say 'Начисл.'color scheme 13 @ 20,47 get c.itog_n disable color scheme 13 @ 20,58 say LTRIM(STR(C.SUM_IT,7,2)) color r/W,,,,,,,,, @ 21,32 to 21,77 color scheme 13 @ 22,35 say 'К оплате' color scheme 13 @ 22,47 get c.itog disable color scheme 13 @ 12,68 say LTRIM(STR(c.kw_pll,6,2)) COLOR N/W,,,,,,,,, @ 13,67 say ltrim(str(c.g_wl,6,2)) color N/W,,,,,,,,, @ 14,67 say ltrim(str(c.x_wl,6,2)) color N/W,,,,,,,,, @ 15,67 say ltrim(str(c.k_ysll,6,2)) color N/W,,,,,,,,, @ 16,67 say ltrim(str(c.otopll,6,2)) color N/W,,,,,,,,, @ 18,67 say ltrim(str(c.tel_rl,6,2)) color N/W,,,,,,,,, @ 17,67 say ltrim(str(c.rad_rl,6,2)) color N/W,,,,,,,,, @ 20,67 SAY LTRIM(STR(C.ITOG_L,7,2)) color n/w READ RETURN FUNCTION EN && Функция для полей базы пункта-Работа с картотекой ON KEY LABEL enter DO pop_vib ON KEY LABEL rightmouse DO pop_vib && KEYBOARD '{enter}' RETURN FUNCTION NE ON KEY LABEL enter ON KEY LABEL rightmouse RETURN FUNCTION pop_vib && READ-меню ON KEY LABEL enter dimension pop(10,1) store ' Постоянная часть ' to pop(1) store ' Начисления ' to pop(2) store ' Жильцы ' to pop(3) store ' Плательщики ' to pop(4) STORE ' Печать ' TO pop(5) store ' Поиск ' to pop(6) STORE ' Дополнение ' TO pop(7) STORE ' Изменение ' TO pop(8) STORE ' Ввод оплаты' TO pop(9) STORE ' Выход из системы ' TO pop(10) store 0 to mpop set color to w/r,r/w, b/n,r* @ 8,28 menu pop(10),10 TITLE 'Выбор за Вами' read menu to mpop set color to DO CASE CASE MPOP=1 DO pos_ch CASE mpop=2 DO nach CASE mpop=3 DO kv_sch CASE mpop=4 DO KDR_R CASE mpop=5 DO print1 CASE mpop=6 ACTIVATE POPUP POISK CASE mpop=7 DO ins WITH 1 IN ADD_DEL CASE mpop=8 DO ins WITH 2 IN ADD_DEL CASE mpop=9 DO vvv IN bazes CASE mpop=10 DO QUIT ENDCASE RETURN FUNCTION sal && Функция отображения в (поле SAY) остатка PARAMETERS s SELE a DO CASE CASE EMPTY(opl_ta) S=c.itog*(-1) CASE !EMPTY(opl_ta) op=opl_ta it=c.itog S=op-it REPLACE OST_K WITH S ENDCASE RETURN S FUNCTION SM && Функция сохранения предыдущего остатка IF !EMPTY(opl_ta).AND.AVS=.F. ACTIVATE WINDOW vib @ 0,1 SAY 'Уплачено ' COLOR G+/B @ 0,10 SAY ALLTRIM(DTOC(D_OPL)) @ 0,21 SAY ' Сумма - ' COLOR G+/B @ 0,30 SAY LTRIM(STR(opl_ta,7,2)) @ 2,2 GET SV2 FUNCTION '*h Дописать;Переписать' VALID sv2() DEFAULT 1; SIZE 1,10,2 color scheme 7 @ 4,3 GET AVS FUNCTION '*C Сохранять автоматически' READ CYCLE OBJECT 1 DEACTIVATE WINDOWS VIB ENDIF RETURN FUNCTION SV2 && Функция выбора кнопок _ DO CASE CASE SV2=1 CLEAR READ SHOW GETS CASE SV2=2 REPLACE OPL_TA WITH 0 SHOW GETS ENDCASE RETURN FUNCTION SV3 && Сохранение os=(opl_ta+opl)-c.itog REPLACE opl_ta WITH opl_ta+opl,d_opl WITH dat,ost_k WITH os RETURN FUNCTION SAV && Выбор кнопок DO CASE CASE SAV=1 DO SV3 RELEASE WINDOW M_ZAR CASE SAV=2 CLEAR READ RELEASE WINDOW M_ZAR ENDCASE RETURN **************************************************************************** ******* ** Статус-строка в: Картотеке льготников, База жильцов,Ввод оплаты,счетчика ** **************************************************************************** ******* FUNCTION INFO @ 21,0 clear to 24,80 @ 21,1 TO 24,79 DOUBLE SELE a R=RECNO() Y=YL D=DOM KV=KW_RA LOCATE FOR YL=Y.AND.DOM=D.AND.KW_RA=KV.AND.OR_R=1 IF RECNO()=R @ 21,1 fill to 24,79 color scheme 12 @ 22,3 say 'Кол-во жильцов - '+ltrim(str(kol(0))) color scheme 12 @ 23,3 say 'Из них льготников - ' +ltrim(str(kl_l(0))) COLOR SCHEME 12 @ 22,30 say 'К оплате - ' color scheme 12 @ 22,41 get c.itog disable color scheme 12 @ 23,30 say 'Сальдо - 'color scheme 12 @ 23,41 get ost_k disable color scheme 12 ELSE @ 21,1 fill to 24,79 color scheme 12 @ 22,5 SAY 'Привязан к - ' color scheme 12 @ 22,20 SAY ALLTRIM(FAM) @ 23,5 SAY 'Табель - ' color scheme 12 @ 23,20 SAY ALLTRIM(STR(tab)) endif GO R RETURN FUNCTION INFO3 && Статус-строка в процедуре: Ввод оплаты @ 21,0 clear to 24,80 @ 21,1 TO 24,79 DOUBLE R=RECNO() Y=YL D=DOM KV=KW_RA @ 21,1 fill to 24,79 color scheme 12 @ 22,3 SAY 'Адрес: '+YL+' Дом '+dom+' Кв-ра '+kw_ra @ 23,3 say 'Кол-во жильцов - '+ltrim(str(kol(0))) color scheme 12 @ 23,26 say 'Из них льготников - ' +ltrim(str(kl_l(0))) COLOR SCHEME 12 FUNCTION r && Функция обновления при работе с базой по оплате счетчика REPLACE for tab=c.tab c.el_c WITH _elek*(a.elec1-a.elec),; c.itog_n WITH c.itog_n+c.el_c,c.itog WITH c.itog+c.el_c RETURN ** Функции к Процедурам РАСЧЕТОВ ** **************************************************************************** ******* ** Процедура расчета по квартплате ** **************************************************************************** ******* FUNCTION ras_1 DEACTIVATE WINDOW vib DO CASE CASE rs_n=1 CLEAR READ SELE c ZAP APPEND FROM rabot FIELDS tab,yl,dom,kw_ra,lgot,n_lg,or_r,kol_vo,kw_l,; tel_l,g_w_l,x_w_l,k_ys_l,el_c_l,otop_l,kv_m reindex CLOSE DATA USE rabot IN a SET FILTER TO or_r=1 SELECT b USE oplata ******Создание новой базы из двух имеющихся (RABOT and OPLATA)********************* JOIN WITH a TO rach FOR yl=a.yl.and.dom=a.dom.and.kw_ra=a.kw_ra.and.tab=a.tab; FIELDS a.fam,a.yl,a.dom,a.kw_ra,a.tel,a.elec,a.elec1,tab,kw_pl,itog_n,tel_r,; rad_r,g_w,x_w,k_ysl,otopl,el_c,a.kol_vo,a.kw_l,a.tel_l,a.rad_l,a.g_w_l,a.x_w _l,; a.k_ys_l,a.el_c_l,a.otop_l,a.kv_m && Вспомогательная база (слияние двух баз) **************************************************************************** ******* CLOSE DATA SELE a USE rach IF .NOT. FILE('rach.cdx') INDEX ON tab TAG tab INDEX ON fam TAG fam INDEX ON yl+dom+kw_ra+str(tab) TAG adrr UNIQUE ENDIF SELE c USE rabot SET ORDER TO ADRR SELE g USE table_r SET ORDER TO tab SELE rach SET RELA TO yl+dom+kw_ra+str(tab) INTO c ADDI SET RELA TO TAB INTO g ADDI ** РАСЧЕТ ** REPLACE ALL kw_pl WITH IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,kv_m,0),; g_w WITH IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,kol_vo,0),; x_w WITH IIF(g.xw_l=0,_xol_w,g.xw_l) *IIF(x_w_l=.t.,kol_vo,0),; k_ysl WITH IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,kol_vo,0),; otopl WITH IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,kv_m,0),; tel_r WITH IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,IIF(empty(tel),0,1),0),; rad_r WITH IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0),; el_c WITH IIF(g.el_l=0,_elek,g.el_l)*IIF(el_c_l=.t.,(elec1-elec),0) REPLACE ALL itog_n WITH kw_pl+tel_r+rad_r+g_w+x_w+k_ysl+el_c+otopl CALCULATE SUM(KW_PL),SUM(G_W),SUM(X_W),SUM(K_YSL),SUM(OTOPL),SUM(RAD_R),; SUM(TEL_R),SUM(EL_C),SUM(ITOG_N) TO SKW,SG,SX,SK,SOT,SR,ST,SEL,SM @ 22,0 SAY 'Кв.плата Гор.вода Хол.вода Ком.усл Отопление Э\энер.Телеф. Радио; ИТОГ ' @ 23,0 SAY LTRIM(STR(SKW,9,2)) @ 23,9 SAY LTRIM(STR(SG,9,2)) @ 23,18 SAY LTRIM(STR(SX,9,2)) @ 23,27 SAY LTRIM(STR(SK,9,2)) @ 23,36 SAY LTRIM(STR(SOT,9,2)) @ 23,46 SAY LTRIM(STR(SEL,9,2)) @ 23,53 SAY LTRIM(STR(ST,9,2)) @ 23,61 SAY LTRIM(STR(SR,7,2)) @ 23,68 SAY LTRIM(STR(SM,9,2)) ON KEY LABEL esc DO vib_8 ON KEY LABEL ctrl+w DO vib_8 ON KEY LABEL ctrl+q DO vib_8 ON KEY LABE F5 ACTIVATE POPUP poisk BROWSE TITLE 'F1 - Помощь ESC - выход F5 - Поиск' FIELDS; tab :h='Таб',; fam :h='Фамилия' ,; kw_pl :h='Кв.пл.' :W=INFO1() :V=INFO2() :F,; g_w :h='Гор.вода' :W=INFO1() :V=INFO2() :F,; x_w :h='Хол.вода' :W=INFO1() :V=INFO2() :F,; k_ysl :h='Ком.усл' :W=INFO1() :V=INFO2() :F,; otopl :h='Отопл.' :W=INFO1() :V=INFO2() :F,; tel_r :h='Телефон' :W=INFO1() :V=INFO2() :F,; rad_r :h='Радио' :W=INFO1() :V=INFO2() :F,; el_c :h='Энергия' :W=INFO1() :V=INFO2() :F,; itog_n :H='Итог' :W=INFO1() :V=INFO2() :F; WIND KDR COLOR SCHEME 12 RELEASE SKW,SG,SX,SK,SOT,SR,ST,SEL,SM,F clear CASE rs_n=2 CLEAR READ DEACTIVATE WINDOW vib ENDCASE RETURN **************************************************************************** ******* PROCEDURE vib_8 && выбор сохранение данных расчета ON KEY LABE esc ON KEY LABEL ctrl+w ON KEY LABEL ctrl+q DEACTIVATE WINDOW kdr ACTIVATE WINDOW vib @ 2,10 SAY 'Сохранить данные' @ 0,0 FILL TO 8,43 COLOR W+/R @ 5,7 GET rs_1 FUNCTION '*TH Сохранить;Отмена' VALID ras_2() DEFAULT 1; SIZE 1,9,4 COLOR ,,,,w+/n,w+/n,w+/n,,W+/R, READ CYCLE OBJECT 1 RETURN FUNCTION ras_2 && сохранение данных расчета DO CASE CASE rs_1=1 DEACTIVATE WINDOW vib CLEAR READ SELE f use oplata UPDATE ON tab FROM a REPLACE kw_pl WITH a.kw_pl, g_w WITH a.g_w,; tel_r WITH a.tel_r,rad_r WITH a.rad_r,k_ysl WITH a.k_ysl, el_c WITH a.el_c,; otopl WITH a.otopl,x_w WITH a.x_w,itog_n WITH a.itog_n RANDOM SELE a set rela to USE ERASE rach.dbf ERASE rach.cdx close data do open ACTIVATE WINDOW VIB @ 2,10 SAY 'Рассчитать льготы' @ 0,0 FILL TO 8,43 COLOR W+/R @ 5,12 GET rs_l FUNCTION '*TH Да;Нет' DEFA 1 SIZE 1,4,4; COLOR ,,,,w+/n,w+/n,w+/n,,w+/r, READ CYCLE OBJECT 1 DO CASE CASE rs_l=1 DEACTIVATE WINDOW vib CLEAR READ DO ras_l CASE rs_l=2 CLEAR READ DEACTIVATE WINDOW vib ENDCASE CASE rs_1=2 DEACTIVATE WINDOW vib SET RELA TO USE CLEAR READ DEACTIVATE WINDOW kdr ERASE rach.dbf ERASE rach.cdx CLOSE DATA DO open ENDCASE RETURN **************************************************************************** ******* ** Процедура расчета по льготам ** **************************************************************************** ******* FUNCTION ras_lg DEACTIVATE WINDOW vib DO CASE CASE rs_lg=1 CLEAR READ CLOSE DATA USE rabot IN a **********************************Альтернатива****************************** ******* ** SET FILTER TO lgot=.t..AND.EMPTY(dat_c).AND.; ** ** EMPTY(dat_po).OR.BETWEEN(date(),dat_c,dat_po) ** SET ORDER TO DATE SELECT b USE oplata ******Создание новой базы из двух имеющихся (RABOT and OPLATA)********************* JOIN WITH a TO rach_l FOR yl=a.yl.and.dom=a.dom.and.kw_ra=a.kw_ra.and.tab=a.tab; FIELDS a.fam,a.yl,a.dom,a.kw_ra,a.tel,a.elec,a.elec1,a.n_lg,tab,kw_pll,itog_l,; kv_m,tel_rl,rad_rl,g_wl,x_wl,k_ysll,otopll,el_cl,a.kol_vo,a.kw_l,a.tel_l,a.r ad_l,; a.g_w_l,a.x_w_l,a.k_ys_l,a.el_c_l,a.otop_l **************************************************************************** ******* CLOSE DATA SELE a USE rach_l IF .NOT. FILE('rach_l.cdx') INDEX ON tab TAG tab INDEX ON fam TAG fam INDEX ON n_lg TAG n_lg INDEX ON yl+dom+kw_ra+str(tab) TAG adrr ENDIF SET ORDER TO tab SELE c USE rabot SET ORDER TO adrr SELE d USE lgot SET ORDER TO n_lg SELE g USE TABLE_R SET ORDER TO tab SELE rach_l SET RELA TO n_lg INTO d ADDI SET RELA TO yl+dom+kw_ra+str(tab) into c ADDI SET RELA TO tab INTO g ADDI **************************************************************************** ******* ** РАСЧЕТ ** **************************************************************************** ******* REPLACE ALL kw_pll WITH (IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,(kv_m/kol_vo),0))*d.kwp_l*(- 1),; g_wl WITH (IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,(-1),0))*d.gw_l,x_wl WITH; (IIF(g.xw_l=0,_xol_w,g.xw_l)*IIF(x_w_l=.t.,(-1),0))*d.xw_l,k_ysll WITH; (IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,(-1),0))*d.k_l_l,otopll WITH; (IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,(kv_m/kol_vo),0))*d.ot_l*(-1),; rad_rl WITH (IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0))*d.rd_l*(- 1),tel_rl WITH; (IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,1,0))*d.tl_l*(-1) REPLACE ALL itog_l WITH kw_pll+g_wl+x_wl+k_ysll+otopll+tel_rl+rad_rl CALCULATE SUM(KW_PLL),SUM(G_WL),SUM(X_WL),SUM(K_YSLL),SUM(OTOPLL),SUM(RAD_RL),; SUM(TEL_RL),SUM(EL_CL),SUM(ITOG_L) TO SKW,SG,SX,SK,SOT,SR,ST,SEL,SM CLEAR @ 22,0 SAY 'Кв.плата Гор.вода Хол.вода Ком.усл Отопление Э\энер.Телеф. Радио; ИТОГ ' @ 23,0 SAY LTRIM(STR(SKW,9,2)) @ 23,9 SAY LTRIM(STR(SG,9,2)) @ 23,18 SAY LTRIM(STR(SX,9,2)) @ 23,27 SAY LTRIM(STR(SK,9,2)) @ 23,36 SAY LTRIM(STR(SOT,9,2)) @ 23,46 SAY LTRIM(STR(SEL,9,2)) @ 23,53 SAY LTRIM(STR(ST,9,2)) @ 23,61 SAY LTRIM(STR(SR,7,2)) @ 23,68 SAY LTRIM(STR(SM,9,2)) ON KEY LABEL esc DO vib_9 ON KEY LABEL F5 ACTIVATE POPUP poisk ON KEY LABEL ctrl+w DO vib_8 ON KEY LABEL ctrl+q DO vib_8 BROWSE TITLE ' F1 - Помощь ESC - выход F5 - Поиск' FIELDS; tab :h='Таб',; fam :h='Фамилия',; kw_pll :h='Кв.пл.' :W=INFO4() :V=INFO5() :F,; g_wl :h='Гор.вода':W=INFO4() :V=INFO5() :F,; x_wl :h='Хол.вода' :W=INFO4() :V=INFO5() :F,; k_ysll :h='Ком.усл' :W=INFO4() :V=INFO5() :F,; otopll :h='Отопл.' :W=INFO4() :V=INFO5() :F,; tel_rl :h='Телефон' :W=INFO4() :V=INFO5() :F,; rad_rl :h='Радио' :W=INFO4() :V=INFO5() :F,; el_cl :h='Энергия' :W=INFO4() :V=INFO5() :F,; itog_l :H='Итог' :W=INFO4() :V=INFO5() :F; WIND KDR COLOR SCHEME 12 RELEASE SKW,SG,SX,SK,SOT,SR,ST,SEL,SM,F CASE rs_lg=2 CLEAR READ DEACTIVATE WINDOW vib ENDCASE PROCEDURE vib_9 ON KEY LABE esc ON KEY LABEL ctrl+w ON KEY LABEL ctrl+q DEACTIVATE WINDOW kdr ACTIVATE WINDOW vib @ 2,10 SAY 'Сохранить данные' @ 0,0 FILL TO 8,43 COLOR W+/R @ 5,7 GET rs_lg_1 FUNCTION '*h Сохранить;Отмена' DEFAULT 1; SIZE 1,9,4 COLOR ,,,,w+/n,w+/n,w+/n,,W+/R, READ CYCLE OBJECT 1 DO CASE CASE rs_lg_1=1 DEACTIVATE WINDOW vib SELE f USE OPLATA UPDATE ON tab FROM a REPLACE kw_pll WITH a.kw_pll, g_wl WITH a.g_wl,; tel_rl WITH a.tel_rl,rad_rl WITH a.rad_rl,k_ysll WITH a.k_ysll,; el_cl WITH a.el_cl,otopll WITH a.otopll,x_wl WITH a.x_wl,itog_l WITH a.itog_l SELE a USE ERASE rach_l.dbf ERASE rach_l.cdx ERASE date.idx CLOSE DATA CLEAR DO open CASE rs_lg_1=2 DEACTIVATE WINDOW vib SELE a USE ERASE rach_l.dbf ERASE rach_l.cdx ERASE date.idx ENDCASE DO open **************************************************************************** ******* ** Расчет (квартплата - льготы = к оплате) ** **************************************************************************** ******* PROCEDURE ras_3 DO CASE CASE rs_i=1 DEACTIVATE WINDOW vib CLEAR READ CLEAR @ 12,35 SAY 'Идет расчет' close data use oplata in a set order to adr sele b use rabot set order to adrr sele a m=RECCOUNT() go top DO WHILE !EOF() y_l=yl do while y_l=yl d=dom do while y_l=yl AND d=dom k=kw_ra STORE 0 TO it_l,s_kw,s_gw,s_xw,s_kysl,s_ot,s_tl,s_rd scan while yl=y_l.and.dom=d.and.kw_ra=k &&.and.a.yl=y_l.and.a.dom=d.and.a.kw_ra=k IF or_r=1 it=itog_n r=RECNO() ENDIF IF lgot=.T. it_l=itog_l+it_l s_kw=kw_pll+s_kw s_gw=g_wl+s_gw s_xw=x_wl+s_xw s_kysl=k_ysll+s_kysl s_ot=otopll+s_ot s_tl=tel_rl+s_tl s_rd=rad_rl+s_rd ENDIF ENDSCAN n=RECNO() os=it+it_l GO r t=tab REPLACE itog WITH os,sum_it WITH it_l,sum_kw WITH s_kw,sum_gw WITH s_gw,; sum_xw WITH s_xw,sum_ot WITH s_ot,sum_tl WITH s_tl,sum_rd WITH s_rd,; sum_kysl WITH s_kysl sele b && Определение остатка(задолженности) locate for tab=t && квартиросъемщика if found().and.empty(opl_ta) replace ost_k WITH os*(-1) else REPLACE ost_k WITH opl_ta-os ENDIF sele a IF N>M DO BROW_OPL RETURN ELSE GO n ENDIF enddo enddo enddo deactivate window vib CASE rs_i=2 clear read deactivate window vib ENDCASE RETURN FUNCTION BROW_OPL && Просмотр начислений DO open SET PROCEDURE TO func ON KEY LABE F5 ACTIVATE POPUP poisk STORE .T. TO _PAD_OTCH BROWSE FOR or_r=1 TITLE 'ESC - выход F5 - Поиск' FIELDS; tab :h='Таб.' :W=INFO3(),; fam :h='Фамилия' :W=INFO3() :25,; lg=IIF(lgot=.t.,'v','') :1 :h='' :W=INFO3(),; c.itog :h='К оплате':10 :W=INFO3(),; x=iif(or_r=1,'=','') :h='' :W=INFO3(),; c.itog_n :h='Начислен':10 :W=INFO3(),; y=iif(or_r=1,'+','') :h='' :W=INFO3(),; c.sum_it :h='По льготе' :10 :W=INFO3(); WIND kdr COLOR SCHEME 12 ON KEY CLEAR RETURN ** Функция отображения суммы начислений по квартплате ** ** в процедуре расчета по квартплате (просмотр начислений) ** **************************************************************************** ******* FUNCTION INFO1 DO CASE CASE VARREAD()='Kw_pl' @ 22,0 fill to 23,8 COLOR SCHEME 12 CASE VARREAD()='G_w' @ 22,8 fill to 23,17 COLOR SCHEME 12 CASE VARREAD()='X_w' @ 22,17 fill to 23,26 COLOR SCHEME 12 CASE VARREAD()='K_ysl' @ 22,26 fill to 23,35 COLOR SCHEME 12 CASE VARREAD()='Otopl' @ 22,35 fill to 23,45 COLOR SCHEME 12 CASE VARREAD()='El_c' @ 22,45 fill to 23,52 COLOR SCHEME 12 CASE VARREAD()='Tel_r' @ 22,52 fill to 23,60 COLOR SCHEME 12 CASE VARREAD()='Rad_r' @ 22,60 fill to 23,67 COLOR SCHEME 12 CASE VARREAD()='Itog_n' @ 22,67 fill to 23,79 COLOR SCHEME 12 ENDCASE RETURN FUNCTION INFO2 && Функция отображения суммы начислений по квартплате DO CASE && в процедуре расчета по квартплате (просмотр начислений) CASE VARREAD()='Kw_pl' @ 22,0 fill to 23,8 COLOR SCHEME 1 CASE VARREAD()='G_w' @ 22,8 fill to 23,17 COLOR SCHEME 1 CASE VARREAD()='X_w' @ 22,17 fill to 23,26 COLOR SCHEME 1 CASE VARREAD()='K_ysl' @ 22,26 fill to 23,35 COLOR SCHEME 1 CASE VARREAD()='Otopl' @ 22,35 fill to 23,45 COLOR SCHEME 1 CASE VARREAD()='El_c' @ 22,45 fill to 23,52 COLOR SCHEME 1 CASE VARREAD()='Tel_r' @ 22,52 fill to 23,60 COLOR SCHEME 1 CASE VARREAD()='Rad_r' @ 22,60 fill to 23,67 COLOR SCHEME 1 CASE VARREAD()='Itog_n' @ 22,67 fill to 23,79 COLOR SCHEME 1 ENDCASE FUNCTION INFO4 && Функция отображения суммы начислений по квартплате DO CASE && в процедуре расчета по квартплате (просмотр начислений) CASE VARREAD()='Kw_pll' @ 22,0 fill to 23,8 COLOR SCHEME 12 CASE VARREAD()='G_wl' @ 22,8 fill to 23,17 COLOR SCHEME 12 CASE VARREAD()='X_wl' @ 22,17 fill to 23,26 COLOR SCHEME 12 CASE VARREAD()='K_ysll' @ 22,26 fill to 23,35 COLOR SCHEME 12 CASE VARREAD()='Otopll' @ 22,35 fill to 23,45 COLOR SCHEME 12 CASE VARREAD()='El_cl' @ 22,45 fill to 23,52 COLOR SCHEME 12 CASE VARREAD()='Tel_rl' @ 22,52 fill to 23,60 COLOR SCHEME 12 CASE VARREAD()='Rad_rl' @ 22,60 fill to 23,67 COLOR SCHEME 12 CASE VARREAD()='Itog_l' @ 22,67 fill to 23,79 COLOR SCHEME 12 ENDCASE RETURN FUNCTION INFO5 && Функция отображения суммы начислений по квартплате DO CASE && в процедуре расчета по квартплате (просмотр начислений) CASE VARREAD()='Kw_pll' @ 22,0 fill to 23,8 COLOR SCHEME 1 CASE VARREAD()='G_wl' @ 22,8 fill to 23,17 COLOR SCHEME 1 CASE VARREAD()='X_wl' @ 22,17 fill to 23,26 COLOR SCHEME 1 CASE VARREAD()='K_ysll' @ 22,26 fill to 23,35 COLOR SCHEME 1 CASE VARREAD()='Otopll' @ 22,35 fill to 23,45 COLOR SCHEME 1 CASE VARREAD()='El_cl' @ 22,45 fill to 23,52 COLOR SCHEME 1 CASE VARREAD()='Tel_rl' @ 22,52 fill to 23,60 COLOR SCHEME 1 CASE VARREAD()='Rad_rl' @ 22,60 fill to 23,67 COLOR SCHEME 1 CASE VARREAD()='Itog_l' @ 22,67 fill to 23,79 COLOR SCHEME 1 ENDCASE RETURN **************************************************************************** ******* ** Функция перехвата ошибок ** **************************************************************************** ******* FUNCTION EROR PARAMETERS ER DO CASE CASE ER=114 ! DEL *.CDX DO OPEN CASE ER=1707 DO CASE CASE SELECT()=1 USE RABOT CASE SELE()=3 USE OPLATA CASE SELE()=4 USE LGOT CASE SELE()=7 USE TABLE_R ENDCASE ENDCASE RETURN FUNCTION RAS_ON_ONE && Расчет на одного жильца в окне (INS-Работа с картотекой) IF OR_R=0 RETURN ELSE R=RECNO() t=tab ORD_R=ORDER() SET ORDER TO 0 Y=YL D=DOM K=KW_RA SELE c ORD_C=ORDER() set order to tab locate for t=tab DO CASE CASE FOUND()=.F. SELE a SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K GO TOP SELE c APPEND FROM rabot FIELDS tab,yl,dom,kw_ra,lgot,n_lg,or_r,kol_vo,kw_l,tel,; tel_l,rad_l,g_w_l,x_w_l,k_ys_l,el_c_l,otop_l,kv_m,elec,elec1,dat_c,dat_po CASE FOUND() sele a SET SKIP TO SET RELA TO SET ORDER TO tab SELE c UPDATE ON tab FROM a REPLACE lgot WITH a.lgot,n_lg WITH a.n_lg,or_r WITH a.or_r,; kol_vo WITH a.kol_vo,kw_l WITH a.kw_l,tel_l WITH a.tel_l,g_w_l WITH a.g_w_l,; x_w_l WITH a.x_w_l,k_ys_l WITH a.k_ys_l,el_c_l WITH a.el_c_l,otop_l WITH a.otop_l,; rad_l WITH a.rad_l,kv_m WITH a.kv_m,elec WITH a.elec,elec1 WITH a.elec1,; dat_c WITH a.dat_c,; dat_po WITH a.dat_po,tel WITH a.tel endcase SELE a SET SKIP TO SET RELA TO SELE c set rela to tab into g set rela to n_lg into d ADDI SET SKIP TO g,d SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K GO TOP REPLACE ALL kw_pll WITH 0,g_wl WITH 0,x_wl WITH 0,k_ysll WITH 0,; otopll WITH 0,rad_rl WITH 0,tel_rl WITH 0,itog_l WITH 0,; itog WITH 0,sum_it WITH 0,sum_kw WITH 0,sum_gw WITH 0,; sum_xw WITH 0,sum_ot WITH 0,sum_tl WITH 0,sum_rd WITH 0,sum_kysl WITH 0 GO TOP SCAN IF OR_R=1 REPLACE c.kw_pl WITH IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,kv_m,0),; c.g_w WITH IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,kol_vo,0),; c.x_w WITH IIF(g.xw_l=0,_xol_w,g.xw_l) *IIF(x_w_l=.t.,kol_vo,0),; c.k_ysl WITH IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,kol_vo,0),; c.otopl WITH IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,kv_m,0),; c.tel_r WITH IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,IIF(empty(tel),0,1),0),; c.rad_r WITH IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0),; c.el_c WITH IIF(g.el_l=0,_elek,g.el_l)*IIF(el_c_l=.t.,(elec1-elec),0) REPLACE c.itog_n WITH c.kw_pl+c.tel_r+c.rad_r+c.g_w+c.x_w+c.k_ysl+c.el_c+c.otopl ENDIF ENDSCAN SET FILTER TO go top SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K.AND.lgot=.t. go top scan FOR EMPTY(dat_c).AND.EMPTY(dat_po).OR.BETWEEN(date(),dat_c,dat_po) REPLACE kw_pll WITH; (IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,(kv_m/kol_vo),0))*d.kwp_l*(- 1),; g_wl WITH (IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,(-1),0))*d.gw_l,x_wl; WITH (IIF(g.xw_l=0,_xol_w,g.xw_l)*IIF(x_w_l=.t.,(-1),0))*d.xw_l,; k_ysll WITH (IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,(-1),0))*d.k_l_l,; otopll WITH (IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,(kv_m/kol_vo),0))*; d.ot_l*(-1),rad_rl WITH (IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0))*; d.rd_l*(-1),tel_rl WITH (IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,1,0))*d.tl_l*(-1) REPLACE itog_l WITH kw_pll+g_wl+x_wl+k_ysll+otopll+tel_rl+rad_rl endscan go top CALCULATE SUM(KW_PLL),SUM(G_WL),SUM(X_WL),SUM(K_YSLL),SUM(OTOPLL),; SUM(RAD_RL),SUM(TEL_RL),SUM(EL_CL),SUM(ITOG_L); TO SKW,SG,SX,SK,SOT,SR,ST,SEL,SM go top set filter to os=0 OST=0 SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K go top scan IF or_r=1 os=itog_n+SM REPLACE itog WITH os,sum_it WITH SM,sum_kw WITH SKW ,sum_gw WITH SG,; sum_xw WITH SX,sum_ot WITH SOT,sum_tl WITH ST,sum_rd WITH SR,; sum_kysl WITH SK ENDIF ENDSCAN SET FILTER TO SET SKIP TO set rela to set order to &ord_c SELE a SET FILTER TO go r REPLACE ost_k WITH os-opl_ta DO OPEN GO R @ 10,27 CLEAR TO 20,51 =POS_CH1() SHOW GETS SET ORDER TO &ORD_R ENDIF RETURN **************************************************************************** ******* ** Функция заполнения и изменения тарифов («СЕРВИС»-«Тарифы») ** **************************************************************************** ******* FUNCTION TARIFS_zar && Окно тарифов, при выборе пункта меню «СЕРВИС»- «Тарифы» HIDE POPUP serv ON KEY on key label ESC do ret_ecs sele a _REC=RECNO() sele f DEFINE WINDOW m_zar1 FROM 5,12 TO 20,66 FILL '-'COLOR SCHEME 18 DEFINE MENU TARIFS DEFINE PAD vibor OF TARIFS PROMPT 'Просмотр' DEFINE PAD apend OF TARIFS PROMPT 'Добавить' DEFINE PAD exit OF TARIFS PROMPT 'Выйти' ON PAD vibor OF TARIFS ACTIVATE POPUP TAR_S ON SELECTION PAD apend OF TARIFS DO INS_ST WITH PROMPT() ON SELECTION PAD exit OF TARIFS DO INS_ST WITH PROMPT() DEFINE POPUP TAR_S FROM 1,1 TITLE; 'Описание тарифа--------|-Ставка-|-Расчен на-|'; PROMPT FIELD info+'|'+STR(st_ka,8,2)+'|'+k_info ON SELECTION POPUP TAR_S DO INS_REC WITH PROMPT(),RECNO() ACTIVATE WINDOW M_ZAR1 ACTIVATE MENU TARIFS on key label ESC DEACTIVATE WINDOW M_ZAR1 RETURN FUNCTION INS_rec PARAMETERS mprompt,mrecno hide popup TAR_S SELE F if empty(mprompt) go mrecno delete else go mrecno SCATTER MEMVAR @ 2,2 SAY 'Введите описание тарифа' @ 3,2 get m.info @ 5,2 SAY 'Ставка - 'get m.st_ka PICTURE '##.##' @ 7,2 GET ras_on FUNCTION '*R На 1 кв.метр;На 1-го чел' VALID kv_chel() defa 1 COLOR SCHEME 16 @ 10,2 GET ras_on1 FUNCTION '*H Сохранить;Отказ' VALID del_rec1() defa 1; COLOR SCHEME 15 size 1,10,4 @ 12,8 GET del_rec FUNCTION '*H Удалить' VALID del_rec() defa 1; size 1,10,4 READ CYCLE ENDIF PACK FUNCTION ret_ecs DEACTIVATE WINDOW M_ZAR1 DEACTIVATE MENU FUNCTION DEL_REC delete clear RETURN FUNCTION DEL_REC1 DO CASE CASE ras_on1=1 IF m.k_ch=.t. m.k_info='На 1-го чел.' ELSE m.k_info='На 1 кв.метр' ENDIF GATHER MEMVAR CASE ras_on1=2 clear READ ENDCASE CLEAR RETURN ----------------------- [pic]