if pcount()=0
restscreen(24,0,24,79,NORTSCR)
else
if pcount()=1
NUM=0
endif
ROW=row()
COL=col()
NORTSCR=savescreen(24,0,24,79)
CL=setcolor(AT_N_I)
@ 24,00 say space(80)
for I=0 to 9
setcolor(AT_N_I)
@ 24,I*8 say str(I+1,iif(I=9,2,1))
setcolor(AT_N_S)
if substr(BINSTR,I+1,1)="1"
@ 24,I*8+iif(I=9,2,1) say iif(NUM=0,MHP[I+1],MHPA[I+1])
else
@ 24,I*8+iif(I=9,2,1) say " "
endif
next
setcolor(CL)
@ ROW,COL say ""
endif
return 0
Function _WAIT
static WAITSCR
parameters STROKE
local CL,ROW,COL,X1,LENM
if pcount()=0
restscreen(11,0,15,79,WAITSCR)
else
ROW=row()
COL=col()
WAITSCR=savescreen(11,0,15,79)
CL=setcolor("+BG/B")
if empty(STROKE)
_open_n(12,20,14,59)
else
LENM=max(len(STROKE),31)
X1=(74-LENM)/2
_open_n(11,X1,14,X1+6+LENM)
setcolor("+BG/B")
@ 12,X1+3+iif(LENM=31,(31-len(STROKE))/2,0) say STROKE
endif
setcolor("+BG/B")
@ 13,25 say "нФХДЮИРЕ НЙНМВЮМХЪ НОЕПЮЖХХ"
setcolor("+BG/B*")
@ 13,52 say " ..."
endif
@ ROW,COL say ""
setcolor(CL)
return 0
яХМРЮЙЯХЯ:
selopt(expN,arrC,arrN,arrC,expN,expL,expL,expC,expC,expL)
оЮПЮЛЕРПШ:
1 МНЛЕП МЮВЮКЭМНИ НОЖХХ ЛЕМЧ
2 ЛЮЯЯХБ НОЖХИ
3 ЛЮЯЯХБ ЙННПДХМЮР НОЖХИ (ЯРПНЙЮ/ЯРНКАЕЖ)
4 ЛЮЯЯХБ ОНДЯЙЮГНЙ
5 МЮВЮКЭМЮЪ ЯРПНЙЮ/ЯРНКАЕЖ БШБНДЮ НОЖХИ
6 ТКЮЦ БШБНДЮ (.T. БЕПРХЙЮКЭМН,.F. ЦНПХГНМРЮКЭМН)
7 ТКЮЦ БШБНДЮ ОНДЯЙЮГНЙ (.T. БШБНДХРЭ Б 24 ЯРПНЙЕ)
8 ЖБЕР БШАПЮММНИ НОЖХХ
9 ЖБЕР МЕБШАПЮММНИ НОЖХХ
10 ТКЮЦ ОПНПХЯНБЙХ РЕМХ НОЖХХ (default - none)
бНГБПЮР:
мНЛЕП БШАПЮММНИ НОЖХХ КХАН 0 ОПХ ОПЕПШБЮМХХ БШАНПЮ
Function SELOPT
parameters NOPT,MO,MC,ME,COLROW,ORIENT,SAYHELP,CLRS,CLRN,CSD
local CL
private NOPT, COUN, INDO, INDM, INDN, MO, MC, ME, COLROW, ORIENT, SAYHELP, CLRS, CLRN, STAT, KL, ROWMO, IN
if pcount()<10
SHD=.F.
else
CSD="N"+substr(CSD,at("/",CSD))
SHD=.T.
endif
keyboard chr(0)
COLORN="R"+substr(CLRN,at("/",CLRN))
COLORS="R"+substr(CLRS,at("/",CLRS))
L_showcurs()
NOPT=iif(NOPT=0,1,NOPT) && мНЛЕП МЮВЮКЭМНИ НОЖХХ ЛЕМЧ
COUN=len(MO) && йНКХВЕЯРБН НОЖХИ
store NOPT to INDO,INDN,INDM
CL=setcolor()
for IN=1 to COUN
setcolor(CLRN)
@ iif(ORIENT,MC[IN],COLROW),iif(ORIENT,COLROW,MC[IN]) ;
SAY strtran(MO[IN],"~","")
if (POS:=at("~",MO[IN]))>0
setcolor(COLORN)
@ iif(ORIENT,MC[IN],COLROW),iif(ORIENT,COLROW+POS-1,MC[IN]+POS-1);
SAY substr(MO[IN],POS+1,1)
setcolor(CL)
endif
if SHD
setcolor (CSD)
@ iif(ORIENT,MC[IN]+1,COLROW+1),iif(ORIENT,COLROW+1,MC[IN]+1);
SAY repl("-",len(strtran(MO[IN],"~","")))
@ iif(ORIENT,MC[IN],COLROW),iif(ORIENT,COLROW+;
len(strtran(MO[IN],"~","")),MC[IN]+;
len(strtran(MO[IN],"~",""))) SAY "-"
setcolor(CL)
endif
NEXT
COLMO=L_getxposn()/8
ROWMO=L_getyposn()/8
setcolor(CLRS)
L_hidecurs()
@ iif(ORIENT,MC[NOPT],COLROW),iif(ORIENT,COLROW,MC[NOPT]);
SAY strtran(MO[NOPT],"~","")
if (POS:=at("~",MO[NOPT]))>0
CL= setcolor(COLORS)
@ iif(ORIENT,MC[NOPT],COLROW),iif(ORIENT,COLROW+POS-1,MC[NOPT]+POS-1) ;
SAY substr(MO[NOPT],POS+1,1)
setcolor(CL)
endif
if SAYHELP
setcolor(At_M0_N)
@ 24,(80-len(ME[INDN]))/2 SAY ME[INDN]
endif
L_showcurs()
KEYPRESSED=.F.
do while .T.
COLMN=L_getxposn()/8
ROWMN=L_getyposn()/8
STAT=L_getmstat()
KL=inkey()
if KL>0
KEYPRESSED=.T.
else
KEYPRESSED=.F.
endif
if KL=13
L_hidecurs()
return INDN
endif
if STAT=2.or.KL=27
if KL<>27
for TT=1 to COUN
if iif(ORIENT,COLMN>=COLROW.and.COLMN<=COLROW+;
len(strtran(MO[TT],"~","")).and.ascan(MC,ROWMN)<>0,;
ROWMN=COLROW.and.COLMN>=MC[TT].and.COLMN<=MC[TT]+;
len(strtran(MO[TT],"~","")))
L_hidecurs()
return 0
endif
next
else
L_hidecurs()
return 0
endif
endif
if iif(ORIENT,(COLMN>=COLROW.AND.COLMN<=COLROW + ;
len(strtran( MO[INDN],"~","")) .AND. ;
ROWMN<>ROWMO).or.KEYPRESSED,(ROWMN=COLROW.AND.;
COLMN<>COLMO).or.KEYPRESSED)
T1=.F.
if ORIENT.and.KL=0
TEST=ascan(MC,ROWMN)
if TEST<>0
T1=.T.
endif
elseif .not.ORIENT.and.KL=0
TEST=INDO
for TT=1 to COUN
if COLMN>=MC[TT].and.COLMN<=MC[TT]+len(strtran(MO[TT],"~",""))
TEST=TT
T1=.T.
exit
endif
next
elseif KL>0
T1=.T.
endif
if T1
do case
case KL=5.or.KL=19
INDN=iif(INDN=1,COUN,INDN-1)
case KL=24.or.KL=4
INDN=iif(INDN=COUN,1,INDN+1)
case KL>=32.and.KL<=255
STROKE="~"+chr(KL)+"~"
for II=1 to COUN
if at(STROKE,MO[II])<>0
INDN=II
keyboard chr(13)
exit
endif
next
otherwise
INDN=TEST
endcase
setcolor(CLRN)
L_hidecurs()
@ iif(ORIENT,MC[INDO],COLROW),iif(ORIENT,COLROW,MC[INDO]);
SAY strtran(MO[INDO],"~","")
if (POS:=at("~",MO[INDO]))>0
CL=setcolor(COLORN)
@ iif(ORIENT,MC[INDO],COLROW),iif(ORIENT,COLROW+POS-1,MC[INDO]+;
POS-1) SAY substr(MO[INDO],POS+1,1)
setcolor(CL)
endif
if SAYHELP
setcolor(At_M0_N)
@ 24,(80-len(ME[INDN]))/2 SAY ME[INDN]
endif
setcolor(CLRS)
@ iif(ORIENT,MC[INDN],COLROW),iif(ORIENT,COLROW,MC[INDN]);
SAY strtran(MO[INDN],"~","")
if (POS:=at("~",MO[INDN]))>0
setcolor(COLORS)
@ iif(ORIENT,MC[INDN],COLROW),iif(ORIENT,COLROW+POS-1,MC[INDN]+POS-1)
SAY substr(MO[INDN],POS+1,1)
endif
L_showcurs()
INDO=INDN
ROWMO=ROWMN
COLMO=COLMN
if STAT=0
loop
endif
endif
elseif COLMN>=COLROW
do case
case STAT=1
for TT=1 to COUN
if iif(ORIENT,COLMN>=COLROW.and.COLMN<=COLROW+;
len(strtran(MO[TT],"~","")).and.ascan(MC,ROWMN)<>0,;
ROWMN=COLROW.and.COLMN>=MC[TT].and.COLMN<=MC[TT]+;
len(strtran(MO[TT],"~","")))
L_hidecurs()
return INDN
endif
next
case STAT=2
for TT=1 to COUN
if iif(ORIENT,COLMN>=COLROW.and.COLMN<=COLROW+;
len(strtran(MO[TT],"~","")).and.ascan(MC,ROWMN)<>0,;
ROWMN=COLROW.and.COLMN>=MC[TT].and.COLMN<=MC[TT]+;
len(strtran(MO[TT],"~","")))
L_hidecurs()
return 0
endif
next
endcase
endif
enddo
return 0
Function FINS
FINSERT=.not.FINSERT
readinsert(FINSERT)
if setcursor()<>0
CUR_STYLE=iif(FINSERT,2,1)
setcursor(CUR_STYLE)
endif
clear type
return 0
Function UpperR(String)
local SRC:={"Ю","А","Б","Ц","Д","Е","╦","Ф","Г","Х","И","Й","К","Л","М","Н","О","П","Я","Р","С","Т","У","Ж","В","Ь","Ы","Э","Ш","З","Щ","Ч","Ъ"," "},;
DST:={"ю","а","б","ц","д","е","╗","ф","г","х","и","й","к","л","м","н","о","п","я","р","с","т","у","ж","в","ь","ы","э","ш","з","щ","ч","ъ"," "},;
STR:="",KEY:="",INDEXKEY,I
for I=1 to len(STRING)
KEY=substr(STRING,I,1)
if (INDEXKEY:=ascan(SRC,KEY))<>0
STR=STR+DST[INDEXKEY]
else
STR=STR+KEY
endif
next
return STR
Function DOORS
private CLR,ME
CLR=setcolor()
clear type
ME=1
ME=_err(07,02,"бШ ФЕКЮЕРЕ ГЮБЕПЬХРЭ ПЮАНРС ?","","",;
" ~Y~es "," ~N~o ","")
if ME=1.or.ME=-1
close databases
set color to
clear
set printer to
setcursor(1)
showtime()
keyboard chr(0)
L_showcurs()
return .T.
else
setcolor(CLR)
return .F.
endif
return .T.
Function NUMSTRING
parameters NUM1,CODE_CUR
local MR:={.T.,.T.,.F.,.T.},CL,;
MG:={{"" ,"" ,"" ,"" },;
{"ЛХККХЮПД" ,"ЛХККХНМ" ,"РШЯЪВЮ","" },;
{"ЛХККХЮПДЮ" ,"ЛХККХНМЮ" ,"РШЯЪВХ","" },;
{"ЛХККХЮПДНБ","ЛХККХНМНБ","РШЯЪВ" ,"" }},;
SO:=0,DE:=0,ED:=0,TX,NUM,OBL
OBL=select()
if pcount()<2
CODE_CUR=0
endif
use (DATROAD+"Currency") index (DATROAD+"Currency") alias CUR new
seek CODE_CUR
if found()
/*MG[1,4]=alltrim(LONG_NAME0)
MG[2,4]=alltrim(LONG_NAME0)
MG[3,4]=alltrim(LONG_NAME1)
MG[4,4]=alltrim(LONG_NAME2)*/
/*if upperR(substr(trim(LONG_NAME0),len(trim(LONG_NAME0)),1))="ю"*/
MR:={.T.,.T.,.F.,.T.}
/*endif*/
endif
Man_Woman=.F.
STROK=""
GSTROK=""
for I=12 to 3 step -3
NUM=val(substr(str(NUM1,12),I-2,3))
Man_Woman=MR[I/3]
SO=int(NUM/100)
DE=int((NUM-SO*100)/10)
ED=NUM-SO*100-DE*10
TX=4
do case
case ED=1
TX=2
case ED>1.and.ED<=4
TX=3
otherwise
TX=4
endcase
if (DE*10+ED>4.and.DE*10+ED<21)
TX=4
endif
TITLE=GetShort_Name(CODE_CUR)
SUBTITLE=MG[TX,I/3]
STROK=num2str(NUM,Man_Woman,SO,DE,ED)
GSTROK=iif(!empty(STROK).or.I=12,STROK+" "+SUBTITLE,"")+;
" "+GSTROK
next
GSTROK=alltrim(strtran(GSTROK," "," "))
GSTROK=upperR(substr(GSTROK,1,1))+substr(GSTROK,2)
use
select(OBL)
return GSTROK+" "+TITLE
Function NUM2STR
PARAMETERS in_num,Man_Woman,SO,DE,ED
local UNITS[37]
UNITS[ 1] = ""
UNITS[ 2] = iif(Man_Woman,"НДХМ","НДМЮ")
UNITS[ 3] = iif(Man_Woman,"ДБЮ","ДБЕ")
UNITS[ 4] = "РПХ"
UNITS[ 5] = "ВЕРШПЕ"
UNITS[ 6] = "ОЪРЭ"
UNITS[ 7] = "ЬЕЯРЭ"
UNITS[ 8] = "ЯЕЛЭ"
UNITS[ 9] = "БНЯЕЛЭ"
UNITS[10] = "ДЕБЪРЭ"
UNITS[11] = "ДЕЯЪРЭ"
UNITS[12] = "НДХММЮДЖЮРЭ"
UNITS[13] = "ДБЕМЮДЖЮРЭ"
UNITS[14] = "РПХМЮДЖЮРЭ"
UNITS[15] = "ВЕРШПМЮДЖЮРЭ"
UNITS[16] = "ОЪРМЮДЖЮРЭ"
UNITS[17] = "ЬЕЯРМЮДЖЮРЭ"
UNITS[18] = "ЯЕЛМЮДЖЮРЭ"
UNITS[19] = "БНЯЕЛМЮДЖЮРЭ"
UNITS[20] = "ДЕБЪРМЮДЖЮРЭ"
UNITS[21] = "ДБЮДЖЮРЭ"
UNITS[22] = "РПХДЖЮРЭ"
UNITS[23] = "ЯНПНЙ"
UNITS[24] = "ОЪРЭДЕЯЪР"
UNITS[25] = "ЬЕЯРЭДЕЯЪР"
UNITS[26] = "ЯЕЛЭДЕЯЪР"
UNITS[27] = "БНЯЕЛЭДЕЯЪР"
UNITS[28] = "ДЕБЪМНЯРН"
UNITS[29] = "ЯРН"
UNITS[30] = "ДБЕЯРХ"
UNITS[31] = "РПХЯРЮ"
UNITS[32] = "ВЕРШПЕЯРЮ"
UNITS[33] = "ОЪРЭЯНР"
UNITS[34] = "ЬЕЯРЭЯНР"
UNITS[35] = "ЯЕЛЭЯНР"
UNITS[36] = "БНЯЕЛЭЯНР"
UNITS[37] = "ДЕБЪРЭЯНР"
STRING = ""
IN_NUM = int(IN_NUM)
SOT=int(In_NUM/100)
DES=int((In_NUM-SOT*100)/10)
EDN=In_NUM-SOT*100-DES*10
IN_STRING = ltrim(str(IN_NUM))
SCAN_ED=.T.
if SOT>0
STRING=STRING+UNITS[SOT+28]+" "
endif
if DES>1
STRING=STRING+UNITS[DES+19]+" "
elseif DES=1
STRING=STRING+UNITS[DES*10+EDN+1]+" "
SCAN_ED=.F.
endif
if SCAN_ED
STRING=STRING+UNITS[EDN+1]
endif
return STRING
Function GetShort_Name(CODE)
local OBL,MR,ST:=" "
OBL=select()
select CUR
MR=recno()
seek CODE
if found()
ST=SHORT_NAME
endif
goto MR
select(OBL)
return ST
Function MAIN
#Include "Box.ch"
setcursor(0)
if .not.file("V.mem").or..not.file("C.mem")
set curs on
return 0 // юБЮПХИМШИ БШУНД ОПХ НРЯСРЯРБХХ ТЮИКНБ ЦКНАЮКЭМШУ ОЕПЕЛЕММШУ
else
// нАЗЪБКЕМХЕ ЦКНАЮКЭМШУ ОЕПЕЛЕММШУ Х ЯВХРШБЮМХЕ ХУ ХГ ТЮИКЮ
public AT_M0_F,AT_M0_N,AT_M0_S,AT_M0_U,AT_M1_F,AT_M1_N,AT_M1_S
public AT_M1_U,AT_M2_F,AT_M2_N,AT_M2_S,AT_M2_U,AT_E_F,AT_E_N,AT_E_S
public AT_E_U,AT_G_F,AT_G_N,AT_G_S,AT_G_U,AT_S_F,AT_S_N,AT_S_S,AT_S_U
public AT_N_I,AT_N_S
CLFON="N"
clear
restore from c.mem addi
endif
// цКНАЮКЭМШЕ СЯРЮМНБЙХ
setcursor(0)
set date german
set century on
set wrap on
set dele off
set bell off
set confirm on
set scoreboard off
set message to 24 center
restore from v.mem addi
public PAROL,DATROAD,USERDSK,PAGELEN,ETLF,UKZGL,UKTXT,ARCROAD
public ZEROPRINT,FPREOBR,PAGESIZ,DUBLDSK,KEYCR,C_H
public FM,FINSERT,CUR_STYLE,M__EN,MDATE,SETNUM
restore from D addi
store 0 to CROW,CCOL
KEYCR="#4_ф;V*"
PAROL = uncrpt(KEYCR,P__AROL)
DATROAD = D__ATROAD
ARCROAD = A__RCROAD
DUBLDSK = D__UBLDSK
USERDSK = U__SERDSK
PAGELEN = P__AGELEN
PAGESIZ = P__AGESIZ
ETLF = E__TLF
UKZGL = U__KZGL
UKTXT = U__KTXT
SETNUM = S__ETNUM
FPREOBR = .F.
release P__AROL,D__ATROAD,U__SERDSK,S__ETNUM,;
P__AGELEN,P__AGESIZ,E__TLF,U__KZGL,U__KTXT,D__UBLDSK,A__RCROAD
MEN=1
MEN1=1
FINSERT=.F.
CUR_STYLE=1
set key 22 to fins()
declare MMS[ 6],MOP[ 6],MCO[ 6],MNT[12],MHP[10]
// лЮЯЯХБ ЩРХЙЕРНЙ ЯРПНЙХ ОНДЯЙЮГЙХ