FUNC (663360), страница 2
Текст из файла (страница 2)
@ 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















