FUNC (663360), страница 5
Текст из файла (страница 5)
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.rad_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
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
