Автоматизированное рабочее место (FUNC)

Посмотреть архив целиком

Процедурный файл FUNC.PRG

***********************************************************************************

** Функция - Постоянная часть (Работа с картотекой) **

***********************************************************************************

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


Случайные файлы

Файл
122622.rtf
24912-1.rtf
141128.rtf
13219.doc
25585.doc