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