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