Ïàðàìåòðû:
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]
// Ìàññèâ ýòèêåòîê ñòðîêè ïîäñêàçêè
MHP[ 1]="Ïîìîùü"
MHP[ 2]="Äîáàâ."
MHP[ 3]="Ñïèñîê"
MHP[ 4]="Ïîèñê "
MHP[ 5]="Ôèëüòð"
MHP[ 6]="Ñóììà "
MHP[ 7]="Ïå÷àòü"
MHP[ 8]="Óäàë. "
MHP[ 9]="Çàïèñü"
MHP[10]="Âûõîä "
// Ìàññèâ îïöèé ãëàâíîãî ìåíþ ñèñòåìû
MOP[ 1]=" ~Î~ïåðàöèè "
MOP[ 2]=" ~Ñ~ïðàâî÷íèêè "
MOP[ 3]=" î~Ò~÷åòû "
MOP[ 4]=" ~À~ðõèâ "
MOP[ 5]=" ~Ð~àçíîå "
MOP[ 6]=" ~Â~ûõîä "
// Ìàññèâ êîîðäèíàò ãëàâíîãî ìåíþ ñèñòåìû
MCO[ 1]=2
MCO[ 2]=12
MCO[ 3]=25
MCO[ 4]=33
MCO[ 5]=40
MCO[ 6]=48
// Ìàññèâ ñòðîê ïîìîùè
MMS[ 1]="Îôîðìëåíèå ïîêóïêè/ïðîäàæè âàëþòû"
MMS[ 2]=" Ââîä ñïðàâî÷íûõ äàííûõ "
MMS[ 3]=" Âûâîä îò÷åòîâ "
MMS[ 4]=" Ðàáîòà ñ àðõèâîì "
MMS[ 5]=" Íàñòðîéêè ñèñòåìû "
MMS[ 6]=" Âûõîä â MS DOS "
// Ìàññèâ íàçâàíèé ìåñÿöåâ
MNT[ 1]="ßíâàðÿ"
MNT[ 2]="Ôåâðàëÿ"
MNT[ 3]="Ìàðòà"
MNT[ 4]="Àïðåëÿ"
MNT[ 5]="Ìàÿ"
MNT[ 6]="Èþíÿ"
MNT[ 7]="Èþëÿ"
MNT[ 8]="Àâãóñòà"
MNT[ 9]="Ñåíòÿáðÿ"
MNT[10]="Îêòÿáðÿ"
MNT[11]="Íîÿáðÿ"
MNT[12]="Äåêàáðÿ"
setcolor(At_M0_F)
@ 00,00,24,79 BOX " - --"
setcolor(At_M0_N)
@ 00,01 SAY "Îáìåííûé ïóíêò áàíêà"
// Ïðîâåðêà ïàðîëÿ ïîëüçîâàòåëÿ (3 ïîïûòêè)
for II=1 to 3
setcursor(CUR_STYLE)
setcolor(AT_E_F)
_open_n(07,22,11,57)
setcolor(AT_E_N)
_saystr(09,24,"Ââåäèòå Âàø ïàðîëü:")
KL=0
TST=""
do while.T.
KL=inkey(0)
do case
case KL=8
TST=substr(TST,1,len(TST)-1)
case KL=13
exit
otherwise
TST=TST+chr(KL)
endcase
@ 09,45 SAY repl(" ",len(TST)+1)
@ 09,45 SAY repl("»,len(TST))
if len(TST)=10
exit
endif
enddo
if TST=PAROL
@ 09,24 SAY «OK «
exit
else
@ 09,24 SAY «Ïàðîëü íåïðàâèëüíûé «
tone(1500,2)
tone(1700,2)
endif
next
if TST<>PAROL
setcolor("W/N")
clear screen
return
endif
restore screen
// Íàñòðîéêà ïðèíòåðà
if M__EN=2
set printer to BUFFER.PRN
else
M__EN=1
set printer to
endif
setcursor(0)
FM=.F.
setcolor(At_M0_F)
@ 00,01 SAY space(80)
do while.T. // Ãëàâíîå ìåíþ ñèñòåìû
if FM
setcolor(At_M0_F)
@ 00,00,24,79 BOX " - --"
@ 00,01 SAY space(80)
FM=.F.
endif
setcolor("+W/B,+GR/R,,,+BG/B")
MEN=selopt(MEN,MOP,MCO,MMS,0,.F.,.T.,At_M0_S,At_M0_U)
if lastkey()=27.or.MEN=0
if doors()
exit
else
loop
endif
endif
MSCR=savescreen(0,0,24,79)
do case
case MEN=1
operation()
case MEN=2
dictonary()
case MEN=3
report()
case MEN=4
arch()
case MEN=5
system()
case MEN=6
if doors()
exit
endif
endcase
restscreen(0,0,24,79,MSCR)
enddo
setcolor()
release all
return 0
Ôóíêöèÿ âûçîâà ìåíþ «Îïåðàöèè»
Function OPERATION
local M1[5],M2[5],M3[5],MENU
M1[1]=" ~Ï~îêóïêà âàëþòû "
M1[2]=" ï~Ð~îäàæà âàëþòû "
M1[3]=" ~Ê~îíâåðñèÿ âàëþòû "
M2[1]=2
M2[2]=3
M2[3]=4
MENU=1
_open_n(1,0,7,23,B_SINGLE+" ",AT_M1_F)
do while.T.
MENU=selopt(MENU,M1,M2,M3,2,.T.,.F.,AT_M1_S,AT_M1_U)
if MENU=0.or.lastkey()=27
clear type
exit
endif
operCurrency(MENU)
enddo
return 0
Ôóíêöèÿ âûçîâà ìåíþ âåäåíèÿ ñïðàâî÷íèêîâ
Function DICTONARY
local M1[4],M2[4],M3[4],MENU,CL
M1[1]=" ~Ñ~ïèñîê âàëþò "
M1[2]=" ~Ê~óðñîû âàëþò "
M1[3]=" êîäû ~Ö~åííîñòåé "
M1[4]=" Êîäû ~Ä~îêóìåíòîâ "
M2[1]=2
M2[2]=3
M2[3]=4
M2[4]=5
MENU=1
_open_n(1,10,6,32,B_SINGLE+" ",AT_M1_F)
do while.T.
MENU=selopt(MENU,M1,M2,M3,12,.T.,.F.,AT_M1_S,AT_M1_U)
if MENU=0.or.lastkey()=27
clear type
exit
endif
dictonEdit(MENU)
enddo
clear type
return 0
Ôóíêöèÿ âûçîâà ìåíþ «Îò÷åòû»
Function REPORT
local M1[4],M2[4],M3[4],MENU,CL
M1[1]=" Ðååñòð ïî ïî~Ê~óïêå âàëþòû "
M1[2]=" Ðååñòð ïî ~Ï~ðîäàæå âàëþòû "
M1[3]=" Ðååñòð ïî ~Ê~îíâåðñèè âàëþòû "
M1[4]=" ñïðàâêà îá ~Î~ñòàòêàõ íàëè÷íîé âàëþòû "
M2[1]=2
M2[2]=3
M2[3]=4
M2[4]=5
MENU=1
_open_n(1,23,7,64,B_SINGLE+" ",AT_M1_F)
do while.T.
MENU=selopt(MENU,M1,M2,M3,25,.T.,.F.,AT_M1_S,AT_M1_U)
if MENU=0.or.lastkey()=27
clear type
exit
endif
reportOut(MENU)
enddo
clear type
return 0
Ôóíêöèÿ âûçîâà ìåíþ «Ðàçíîå»
Function SYSTEM
private M1,M2,M3,MENU
declare M1[4],M2[4],M3[4]
M1[1]=" ~Ó~ñòàíîâêè "
M1[2]=" ~Ê~îïèÿ äàííûõ "
M1[3]=" ~È~íäåêñíûå ôàéëû "
M1[4]=" ~Ñ~÷åòà áàíêà "
M2[1]=2
M2[2]=3
M2[3]=4
M2[4]=5
MENU=1
SCRS=savescreen(0,0,24,79)
_open_n(1,38,6,58,B_SINGLE+" ",AT_M1_F)
do while.T.
MENU=selopt(MENU,M1,M2,M3,40,.T.,.F.,AT_M1_S,AT_M1_U)
if MENU=0.or.lastkey()=27
clear type
exit
endif
do case
case MENU=1
setupm(M1[MENU])
case MENU=2
dublicat(M1[MENU])
case MENU=3
case MENU=4
GetAccount()
endcase
enddo
restscreen(0,0,24,79,SCRS)
clear type
return 0
Ôóíêöèÿ âûçîâà ìåíþ «Óñòàíîâêè»
Function SETUPM
parameters OPT
private SCR,M1[4],M2[4],M3[4],MENU,OPT,A__RCROAD,P__AROL,D__ATROAD,D__UBLDSK,U__SERDSK,P__AGELEN,P__AGESIZ,E__TLF,U__KZGL,U__KTXT,S__ETNUM,FMOD
ROW=row()
M1[1]=" ~Ï~àðîëü "
M1[2]=" ïóòè ê ~Ä~àííûì "
M1[3]=" ~Ó~ñòàíîâêè ïðèíòåðà "
M1[4]=" ~Ö~âåòà "
M2[1]=ROW+2
M2[2]=ROW+3
M2[3]=ROW+4
M2[4]=ROW+5
MENU=1
FMOD=0
SCR=savescreen(0,0,24,79)
do while.T.
_open_n(ROW+1,38,ROW+6,61,B_SINGLE+" ",AT_M2_F)
MENU=selopt(MENU,M1,M2,M3,40,.T.,.F.,AT_M2_S,AT_M2_U)
if MENU=0.or.lastkey()=27
clear type
exit
endif
if MENU=4
FM=.T.
endif
save screen to SESCR
FMOD=setup(MENU)
restore screen from SESCR
enddo
restscreen(0,0,24,79,SCR)
if FMOD=1
P__AROL = crpt(KEYCR,trim(P__AROL))
D__ATROAD = trim(D__ATROAD)
A__RCROAD = trim(A__RCROAD)
U__KZGL = trim(U__KZGL)
U__KTXT = trim(U__KTXT)
if M__EN=2
set Printer to BUFFER.PRN
else
M__EN=1
set Printer to
endif
if Z__PR=2
ZEROPRINT=.F.
else
Z__PR=1
ZEROPRINT=.T.
endif
save all like?__* to 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
SETNUM =S__ETNUM
UKTXT =U__KTXT
endif
clear type
return 0
Ôóíêöèÿ âûçîâà ìåíþ «Êîïèÿ äàííûõ»
Function DUBLICAT
parameters OPT
private M1,M2,M3,MENU,OPT,DSCR,ROW
ROW=row()
declare M1[2],M2[2],M3[2]
M1[1]=" ~Ñ~îõðàíåíèå äàííûõ "
M1[2]=" ~Â~îññòàíîâëåíèå äàííûõ "
M2[1]=ROW+2
M2[2]=ROW+3
MENU=1
popmenu(ROW,38,ROW+5,64,OPT,2,AT_M2_F)
do while.T.
MENU=selopt(MENU,M1,M2,M3,40,.T.,.F.,AT_M2_S,AT_M2_U)
if MENU=0.or.lastkey()=27
clear type
exit
endif
save screen to DSCR
do case
case MENU=1
OPT=M1[MENU]
savedata(OPT)
case MENU=2
OPT=M1[MENU]
restdata(OPT)
endcase
restore screen from DSCR
enddo
clear type
return 0
Ôóíêöèÿ - ñåëåêòîð îïåðàöèé
Function OPERCURRENCY
#Include "Inkey.ch"
#Include "Box.ch"
parameters N_OPER
do case
case N_OPER=1
ByeCurrency()
case N_OPER=2
SaleCurrency()
case N_OPER=3
ConvertCurrency()
endcase
return 0
Ôóíêöèÿ ðåãèñòðàöèè ïîêóïêè âàëþòû
Function ByeCurrency
local SCR
use (DATROAD+"Document") index (DATROAD+"Document") alias DOC new
SCR=savescreen(1,0,23,61)
CLR=setcolor(AT_G_F)
_open_n(1,0,20,59,B_SINGLE+" ",AT_G_F)
@ 08,0 say "+----------------------------------------------------------+"
@ 14,0 say "+----------------------------------------------------------+"
setcolor(AT_G_N+","+AT_G_S+",,,"+AT_G_U)
set key K_F3 to getcode()
_nort("1010000001")
FINIT=.T.
do while.T.
if FINIT
SER =space(2)
NUM =0
FIO =space(35)
DOC =space(10)
CDOC =0
DSER =space(10)
DNUM =0
REZ =space(1)
NREZ =space(1)
BCODC =10
BCODCUR=2
BSUM =0
SCODC =0
SCODCUR=0
SSUM =0
SSUMS=""
BSUMS=""
@ 12,2 say space(57)
@ 13,2 say space(57)
@ 18,2 say space(57)
@ 19,2 say space(57)
setcolor(AT_G_U)
@ 11,8 say 0 picture "999999999999"
endif
setcolor(AT_G_N+","+AT_G_S+",,,"+AT_G_U)
@ 02,17 say "ÑÏÐÀÂÊÀ" get SER picture "XX" valid!empty(SER)
@ 02,28 say "¹" get NUM picture "9999999" valid!empty(NUM)
@ 03,15 say str(day(date()),2)+" "+MNT[month(date())]+;
" "+str(year(date()),4)
@ 04,02 say "Âûäàíà" get FIO picture "@S30" valid!empty(FIO)
@ 05,02 say "Ïðåäúÿâëåí" get CDOC picture "9999"
@ 05,29 say "ñåðèÿ" get DSER picture "XXXXXXXXXX"
@ 05,46 say "¹" get DNUM picture "9999999999"
@ 06,02 say "Ðåçèäåíò [ ]"
@ 06,12 get REZ Picture "L"
@ 08,02 say "ÏÎËÓ×ÅÍÎ ÊËÈÅÍÒÎÌ:"
@ 09,02 say "Êîä öåííîñòè" get BCODC picture "9999"
@ 10,02 say "Êîä âàëþòû " get BCODCUR picture "9999"
@ 11,02 say "Ñóììà"
@ 14,02 say "ÏÐÈÍßÒÎ ÎÒ ÊËÈÅÍÒÀ:"
@ 15,02 say "Êîä öåííîñòè" get SCODC picture "9999"
@ 16,02 say "Êîä âàëþòû " get SCODCUR picture "9999"
@ 17,02 say "Ñóììà" get SSUM picture "999999999999";
valid saysale(SSUM,18,2,52,AT_G_U,@SSUMS,SCODCUR)
setcursor(CUR_STYLE)
read
setcursor(0)
if lastkey()=K_ESC
exit
endif
if _err(06,40,"Äàííûå ââåäåíû ïðàâèëüíî?","",""," ~Ä~à "," ~Í~åò ","")=1
append blank
replace field->SER_ with SER,;
field->NUM_ with NUM,;
field->FIO_ with FIO,;
field->DOC_ with DOC,;
field->DSER_ with DSER,;
field->DNUM_ with DNUM,;
field->REZ_ with!empty(REZ),;
field->BCODC_ with BCODC,;
field->BCODCUR_ with BCODCUR,;
field->BSUM_ with BSUM,;
field->SCODC_ with SCODC,;
field->SCODCUR_ with SCODCUR,;
field->SSUM_ with SSUM,;
field->DATE_ with date(),;
field->OPERATION_ with 1
commit
if _err(06,40,"Ïå÷àòàòü ñïðàâêó?","",""," ~Ä~à "," ~Í~åò ","")=1
// printspr()
endif
FINIT=.T.
loop
else
FINIT=.F.
endif
enddo
_nort()
set key K_F3 to
restscreen(1,0,23,61,SCR)
dbcloseall()
return 0
Ôóíêöèÿ ðåãèñòðàöèè ïðîäàæè âàëþòû
Function SaleCurrency
local SCR
use (DATROAD+"Document") index (DATROAD+"Document") alias DOC new
SCR=savescreen(1,0,23,61)
CLR=setcolor(AT_G_F)
_open_n(1,0,20,59,B_SINGLE+" ",AT_G_F)
@ 08,0 say "+----------------------------------------------------------+"
@ 14,0 say "+----------------------------------------------------------+"
setcolor(AT_G_N+","+AT_G_S+",,,"+AT_G_U)
set key K_F3 to getcode()
_nort("1010000001")
FINIT=.T.
do while.T.
if FINIT
SER =space(2)
NUM =0
FIO =space(35)
DOC =space(10)
DSER =space(10)
DNUM =0
REZ =space(1)
NREZ =space(1)
CDOC =0
BCODC =0
BCODCUR=0
BSUM =0
SCODC =0
SCODCUR=0
SSUM =0
SSUMS=""
BSUMS=""
@ 12,2 say space(57)
@ 13,2 say space(57)
@ 18,2 say space(57)
@ 19,2 say space(57)
setcolor(AT_G_U)
@ 11,8 say 0 picture "999999999999"
endif
setcolor(AT_G_N+","+AT_G_S+",,,"+AT_G_U)
@ 02,17 say "ÑÏÐÀÂÊÀ" get SER picture "XX" valid!empty(SER)
@ 02,28 say "¹" get NUM picture "9999999" valid!empty(NUM)
@ 03,15 say str(day(date()),2)+" "+MNT[month(date())]+" "+str(year(date()),4)
@ 04,02 say "Âûäàíà" get FIO picture "@S30" valid!empty(FIO)
@ 05,02 say "Ïðåäúÿâëåí" get CDOC picture "9999"
@ 05,29 say "ñåðèÿ" get DSER picture "XXXXXXXXXX"
@ 05,46 say "¹" get DNUM picture "9999999999"
@ 06,02 say "Ðåçèäåíò [ ]"
@ 06,12 get REZ Picture "L"
@ 08,02 say "ÏÐÈÍßÒÎ ÎÒ ÊËÈÅÍÒÀ:"
@ 09,02 say "Êîä öåííîñòè" get SCODC picture "9999"
@ 10,02 say "Êîä âàëþòû " get SCODCUR picture "9999"
@ 11,02 say "Ñóììà"
@ 14,02 say "ÏÎËÓ×ÅÍÎ ÊËÈÅÍÒÎÌ:"
@ 15,02 say "Êîä öåííîñòè" get BCODC picture "9999"
@ 16,02 say "Êîä âàëþòû " get BCODCUR picture "9999"
@ 17,02 say "Ñóììà" get BSUM picture "999999999999" valid saybye(BSUM,17,2,52,AT_G_U,@BSUMS,BCODCUR)
setcursor(CUR_STYLE)
read
setcursor(0)
if lastkey()=K_ESC
exit
endif
if _err(06,40,"Äàííûå ââåäåíû ïðàâèëüíî?","",""," ~Ä~à "," ~Í~åò ","")=1
append blank
replace field->SER_ with SER,;
field->NUM_ with NUM,;
field->FIO_ with FIO,;
field->DOC_ with DOC,;
field->DSER_ with DSER,;
field->DNUM_ with DNUM,;
field->REZ_ with!empty(REZ),;
field->BCODC_ with BCODC,;
field->BCODCUR_ with BCODCUR,;
field->BSUM_ with BSUM,;
field->SCODC_ with SCODC,;
field->SCODCUR_ with SCODCUR,;
field->SSUM_ with SSUM,;
field->DATE_ with date(),;
field->OPERATION_ with 1
commit
if _err(06,40,"Ïå÷àòàòü ñïðàâêó?","",""," ~Ä~à "," ~Í~åò ","")=1
// printspr()
endif
FINIT=.T.
loop
else
FINIT=.F.
endif
enddo
_nort()
set key K_F3 to
restscreen(1,0,23,56,SCR)
dbcloseall()
return 0
Ôóíêöèÿ ðåãèñòðàöèè êîíâåðñèè âàëþòû
Function ConvertCurrency
local SCR
use (DATROAD+"Document") index (DATROAD+"Document") alias DOC new
SCR=savescreen(1,0,23,61)
CLR=setcolor(AT_G_F)
_open_n(1,0,20,59,B_SINGLE+" ",AT_G_F)
@ 08,0 say "+----------------------------------------------------------+"
@ 14,0 say "+----------------------------------------------------------+"
setcolor(AT_G_N+","+AT_G_S+",,,"+AT_G_U)
set key K_F3 to getcode()
_nort("1010000001")
FINIT=.T.
do while.T.
if FINIT
SER =space(2)
NUM =0
FIO =space(35)
DOC =space(10)
DSER =space(10)
DNUM =0
REZ =space(1)
NREZ =space(1)
CDOC =0
BCODC =0
BCODCUR=0
BSUM =0
SCODC =0
SCODCUR=0
SSUM =0
SSUMS=""
BSUMS=""
@ 12,2 say space(57)
@ 13,2 say space(57)
@ 18,2 say space(57)
@ 19,2 say space(57)
setcolor(AT_G_U)
@ 11,8 say 0 picture "999999999999"
endif
setcolor(AT_G_N+","+AT_G_S+",,,"+AT_G_U)
@ 02,17 say "ÑÏÐÀÂÊÀ" get SER picture "XX" valid!empty(SER)
@ 02,28 say "¹" get NUM picture "9999999" valid!empty(NUM)
@ 03,15 say str(day(date()),2)+" "+MNT[month(date())]+" "+str(year(date()),4)
@ 04,02 say "Âûäàíà" get FIO picture "@S30" valid!empty(FIO)
@ 05,02 say "Ïðåäúÿâëåí" get CDOC picture "9999"
@ 05,29 say "ñåðèÿ" get DSER picture "XXXXXXXXXX"
@ 05,46 say "¹" get DNUM picture "9999999999"
@ 06,02 say "Ðåçèäåíò [ ]"
@ 06,12 get REZ Picture "L"
@ 08,02 say "ÏÐÈÍßÒÎ ÎÒ ÊËÈÅÍÒÀ:"
@ 09,02 say "Êîä öåííîñòè" get SCODC picture "9999"
@ 10,02 say "Êîä âàëþòû " get SCODCUR picture "9999"
@ 11,02 say "Ñóììà"
@ 14,02 say "ÏÎËÓ×ÅÍÎ ÊËÈÅÍÒÎÌ:"
@ 15,02 say "Êîä öåííîñòè" get BCODC picture "9999"
@ 16,02 say "Êîä âàëþòû " get BCODCUR picture "9999"
@ 17,02 say "Ñóììà" get BSUM picture "999999999999" valid saybye(BSUM,17,2,52,AT_G_U,@BSUMS,BCODCUR)
setcursor(CUR_STYLE)
read
setcursor(0)
if lastkey()=K_ESC
exit
endif
if _err(06,40,"Äàííûå ââåäåíû ïðàâèëüíî?","",""," ~Ä~à "," ~Í~åò ","")=1
append blank
replace field->SER_ with SER,;
field->NUM_ with NUM,;
field->FIO_ with FIO,;
field->DOC_ with DOC,;
field->DSER_ with DSER,;
field->DNUM_ with DNUM,;
field->REZ_ with!empty(REZ),;
field->BCODC_ with BCODC,;
field->BCODCUR_ with BCODCUR,;
field->BSUM_ with BSUM,;
field->SCODC_ with SCODC,;
field->SCODCUR_ with SCODCUR,;
field->SSUM_ with SSUM,;
field->DATE_ with date(),;
field->OPERATION_ with 1
commit
if _err(06,40,"Ïå÷àòàòü ñïðàâêó?","",""," ~Ä~à "," ~Í~åò ","")=1
// printspr()
endif
FINIT=.T.
loop
else
FINIT=.F.
endif
enddo
_nort()
set key K_F3 to
restscreen(1,0,23,56,SCR)
dbcloseall()
return 0
Ôóíêöèÿ - îïðåäåëèòåëü òåêóùåãî ïîëÿ äëÿ ïîëó÷åíèÿ êîäà è íàèìåíîâàíèÿ îáúåêòà èç ñïðàâî÷íèêà
Function GETCODE
local CL
AKTIV=getactive()
RS=row()
CS=col()+5
do case
case AKTIV:name="BCODCUR"
S=incod(1,@BCODCUR)
case AKTIV:name="BCODC"
S=incod(3,@BCODC)
case AKTIV:name="SCODCUR"
S=incod(1,@SCODCUR)
case AKTIV:name="SCODC"
S=incod(3,@SCODC)
case AKTIV:name="CDOC"
S=incod(4,@CDOC)
otherwise
S=""
endcase
CL=setcolor(AT_G_N)
@ RS,CS say substr(S,1,30)
if!empty(S)
keyboard chr(13)
endif
setcolor(CL)
return.T.
Ôóíêöèÿ âûâîäà ñóììû ïîêóïêè ïðîïèñüþ
Function SAYB
parameters NUM,Y,X,L,C,S,CC
local CL
S=numstring(NUM,CC)
CL=setcolor(C)
@ Y,X say padr(substr(S,1,L),L)
@ Y+1,2 say padr(substr(S,L+1,57),57)
setcolor(AT_G_U)
@ Y-1,8 say NUM picture "999999999999"
setcolor(CL)
return.T.
Ôóíêöèÿ âûâîäà ñóììû ïðîäàæè ïðîïèñüþ
Function SAYS
parameters NUM,Y,X,L,C,S,CC
local CL
S=numstring(NUM,CC)
CL=setcolor(C)
@ Y,X say padr(substr(S,1,L),L)
@ Y+1,2 say padr(substr(S,L+1,57),57)
setcolor(AT_G_U)
@ Y-1,8 say NUM picture "999999999999"
setcolor(CL)
return.T.
Ôóíêöèÿ âû÷èñëåíèÿ ñóììû îïåðàöèè ïîêóïêè
Function SAYBYE
parameters NUM,Y,X,L,C,S,CC
local CL,OBL,RESULT
RESULT=.F.
OBl=select()
use (DATROAD+"currency") index (DATROAD+"currency") new
seek CC
if found()
BSUM=KURS*NUM
use
S=numstring(NUM,CC)
CL=setcolor(C)
@ Y,X say padr(substr(S,1,L),L)
@ Y+1,2 say padr(substr(S,L+1,57),57)
says(SSUM,12,2,57,AT_G_U,@SSUMS,SCODCUR)
RESULT=.T.
else
use
endif
setcolor(CL)
select(OBL)
return RESULT
Ôóíêöèÿ âû÷èñëåíèÿ ñóììû îïåðàöèè ïðîäàæè
Function SAYSALE
parameters NUM,Y,X,L,C,S,CC
local CL,OBL,RESULT
RESULT=.F.
OBl=select()
use (DATROAD+"currency") index (DATROAD+"currency") new
seek CC
if found()
BSUM=KURS*NUM
use
S=numstring(NUM,CC)
CL=setcolor(C)
@ Y,X say padr(substr(S,1,L),L)
@ Y+1,2 say padr(substr(S,L+1,57),57)
sayb(BSUM,12,2,57,AT_G_U,@BSUMS,BCODCUR)
RESULT=.T.
else
use
endif
setcolor(CL)
select(OBL)
return RESULT
ÔÓÍÊÖÈß ÂÛÂÎÄÀ ñïèñêà äîêóìåíòîâ äíÿ
Function Docrep
local SCR
use (DATROAD+"Currency") index (DATROAD+"Currency") alias CUR new
use (DATROAD+"Document") index (DATROAD+"Document") alias DOC new
set relation to BCODCUR_ into CUR
SCR=savescreen(1,0,23,79)
_open_n(1,0,22,77,B_SINGLE+" ",AT_S_F)
_nort("1000001001")
declare MF[5],MZ[5]
MF[1]={|| SER_+str(NUM_,9)}
MF[2]={|| FIO_ }
MF[3]={|| iif(REZ_,"Ð","Í")}
MF[4]={|| CUR->SHORT_NAME+" "+str(BSUM_)}
MF[5]={|| getShort_Name(SCODCUR_)+" "+str(SSUM_)}
MZ[1]="Ñïðàâêà"
MZ[2]="Ôàìèëèÿ Èìÿ Îò÷åñòâî"
MZ[3]="Ð/Í"
MZ[4]="Âûäàíî"
MZ[5]="Ïðèíÿòî"
TERM=" Ïðîâåäåííûå äîêóìåíòû äíÿ "
setcolor(AT_M1_S)
@ 01,(70-len(TERM))/2 SAY TERM
setcolor(AT_S_N+","+AT_S_S+",,,"+AT_S_U)
clear type
oBrow:= TBrowseDB(2,1,21,76)
oBrow:headSep:= "=T="
oBrow:colSep:= " ¦ "
for i:= 1 TO len(MF)
oBrow:addColumn(TBColumnNew(MZ[i], MF[i]))
next
while (!oBrow:stabilize()); end
lKeyWaiting:=.F.
lBrowse:=.T.
do while (lBrowse)
if (!lKeyWaiting)
do while (!oBrow:stabilize())
// Ïðåðâàòü ñòàáèëèçàöèþ, åñëè íàæàòà êëàâèøà
if ((nKey:= Inkey())!= 0)
lKeyWaiting:=.T.
exit
endif
enddo
endif
// Åñëè íåò íàæàòèÿ, òî æäàòü åãî
if (!lKeyWaiting)
nKey:= Inkey(0)
endif
do case
case (nKey == K_DOWN)
oBrow:down()
case (nKey == K_UP)
oBrow:up()
case (nKey == K_PGDN)
oBrow:pageDown()
case (nKey == K_PGUP)
oBrow:pageUp()
case (nKey == K_CTRL_PGUP)
oBrow:goTop()
case (nKey == K_CTRL_PGDN)
oBrow:goBottom()
case (nKey == K_RIGHT)
oBrow:right()
case (nKey == K_LEFT)
oBrow:left()
case (nKey == K_HOME)
oBrow:home()
case (nKey == K_END)
oBrow:end()
case (nKey == K_CTRL_LEFT)
oBrow:panLeft()
case (nKey == K_CTRL_RIGHT)
oBrow:panRight()
case (nKey == K_CTRL_HOME)
oBrow:panHome()
case (nKey == K_CTRL_END)
oBrow:panEnd()
case (nKey == K_F7)
// printspr()
case (nKey == K_ESC).or.(nKey == K_F10)
lBrows