|
|
1. Интерфейсные функции
1.1. Функция вывода окна
Параметры: координаты левого верхнего и правого нижнего угла окна, [строка символов обрамления]
FUNCTION _OPEN_T parameters Y1,X1,Y2,X2,SBOX private XT1,XT2,XK2,SBOX SBOX=iif(empty(SBOX).and.SBOX<>space(9),"???????? ",SBOX) XT1=iif(X1+2>79,79,X1+2) XT2=iif(X2+2>79,79,X2+2) XK2=iif(X2+1>79,79,X2+1) @ Y1,X1,Y2,X2 BOX SBOX shadow(Y2+1,XT1,Y2+1,XT2,0) shadow(Y1+1,XK2,Y2+1,XT2,0) return 0
1.2. Функция вывода окна с эффектом раскрытия
Параметры: координаты левого верхнего и правого нижнего угла окна, [строка символов обрамления],[строка установки цвета]
FUNCTION _OPEN_N
parameters Y1,X1,Y2,X2,S1,COLOR
local CL,XT,YT,XC,YC
if pcount()=4
COLOR=setcolor()
S1=""
elseif pcount()=5
COLOR=setcolor()
endif
YC=Y1+int((Y2-Y1)/2)
XC=X1+int((X2-X1)/2)
CL=setcolor()
if Y2-Y1 >= 2
YC1=YC
YC2=YC
XT=XC
setcolor(COLOR)
do while .T.
_open_t(YC1,XT,YC2,2*XC-XT,S1)
YC1=iif(YC1-2<Y1,Y1,YC1-2)
YC2=iif(YC2+2>Y2,Y2,YC2+2)
if XT=X1
exit
endif
XT=iif(XT-3<X1,X1,XT-3)
inkey()
enddo
if YC1<>Y1
YT=YC1
do while .T.
_open_t(YT,X1,2*YC-YT,X2,S1)
if YT=Y1
exit
endif
YT=iif(YT-2<Y1,Y1,YT-2)
inkey()
enddo
endif
endif
_open_t(Y1,X1,Y2,X2,S1)
setcolor(CL)
return 0
1.2.1. Функция вывода системных сообщений с ожиданием реакции пользователя
Параметры:
координаты левого верхнего угла окна,
строка сообщения 1, строка сообщения 2, строка сообщения 3,
строка выбора 1, строка выбора 2, строка выбора 3,
строка символов обрамления.
FUNCTION _ERR
parameters Y1,X1,S1,S2,S3,M1,M2,M3,SB
private CLR,STATS,Y1,X1,S1,S2,S3,M1,M2,M3,SB,STAT,KL1,MM1,MM2
save screen
CLR=setcolor()
STATS=csetall()
if pcount()=8
SB=""
endif
Y2=Y1+iif(empty(S2),5,iif(empty(S3),6,7))
X2=X1+max(len(S1),max(len(S2),max(len(S3),max(len(M1)+len(M2)+;
len(M3)+5,31))))+4
setcolor(At_E_F)
_open_n(Y1,X1,Y2,X2,SB)
@ Y2-3,X1 SAY "|"+replicate("=",X2-X1-1)+"|"
setcolor(At_E_N)
@ Y1+1,X1+((X2-X1)-len(alltrim(S1)))/2 SAY alltrim(S1)
if .not.empty(S2)
@ Y1+2,X1+((X2-X1)-len(alltrim(S2)))/2 SAY alltrim(S2)
if .not.empty(S3)
@ Y1+3,X1+((X2-X1)-len(alltrim(S3)))/2 SAY alltrim(S3)
endif
endif
if empty(M1)
setcolor(At_E_S)
@ Y2-2,X1+(X2-X1-31)/2 SAY " Нажмите Enter для продолжения "
setcolor("N"+substr(AT_E_F,at("/",AT_E_F)))
@ Y2-1,X1+(X2-X1-31)/2+1 SAY "-------------------------------"
@ Y2-2,X1+(X2-X1-31)/2+31 SAY "-"
L_showcurs()
KL1=0
do while .T.
KL1=inkey()
STAT=L_getmstat()
if KL1<>0.or.STAT<>0
exit
endif
enddo
L_hidecurs()
restore screen
csetall(STATS)
setcolor(CLR)
return 0
elseif empty(M3).and..not.empty(M2)
declare MM1[2],MM2[2]
MM1[1]=M1
MM1[2]=M2
XX=X1+int((X2-X1-len(M1+M2)-1)/2)
MM2[1]=XX
MM2[2]=XX+len(M1)+1
do while .T.
MM=1
MM=selopt(MM,MM1,MM2,"",Y2-2,.F.,.F.,At_E_S,At_E_U,At_E_F)
if MM<>0
restore screen
csetall(STATS)
setcolor(CLR)
return MM
endif
enddo
elseif .not.empty(M1).and..not.empty(M2).and..not.empty(M3)
declare MM1[3],MM2[3]
MM1[1]=M1
MM1[2]=M2
MM1[3]=M3
XX=X1+int((X2-X1-len(M1+M2+M3)-2)/2)
MM2[1]=XX
MM2[2]=XX+len(M1)+1
MM2[3]=XX+len(M1+M2)+2
do while .T.
MM=1
MM=selopt(MM,MM1,MM2,"",Y2-2,.F.,.F.,At_E_S,At_E_U,At_E_F)
if MM<>0
restore screen
csetall(STATS)
setcolor(CLR)
return MM
endif
enddo
endif
csetall(STATS)
setcolor(CLR)
return 0
1.2.2. Функция вывода линей ного индикатор а процесса
FUNCTION _LIN
parameters YCOR,XCOR,LENG,LMAX,LUSE
private YCOR,XCOR,LENG,LMAX,LUSE,STATS,RW,CL
STATS=csetall()
RW=row()
CL=col()
LMAX=iif(LMAX<=0,1,LMAX)
XUSE=int((LENG/LMAX)*LUSE)+XCOR
CLR=setcolor(AT_S_U)
@ YCOR,XCOR,YCOR,XUSE BOX "---------"
setcolor(AT_S_S)
if XUSE<LENG
@ YCOR,XUSE+1,YCOR,XCOR+LENG BOX "---------"
endif
csetall(STATS)
setcolor(CLR)
@ RW,CL SAY ""
return 0
1.2.3. Функция вывода рамки для всплывающего меню
FUNCTION POPMENU
parameters Y1,X1,Y2,X2,OPT,OFFS,COLORF
private Y1,X1,Y2,X2,OPT,OFFS,COLORF,I,CLR
L_hidecurs()
CLR=setcolor(COLORF)
@ Y1,X1 SAY "-"+repl("-",OFFS-1)
@ Y1,X1+OFFS+len(OPT) SAY repl("-",X2-X1-OFFS-len(OPT))+"¬"
shadow(Y1+1,X2+1,Y1+1,X2+2,SHC)
_open_t(Y1+1,X1,Y2,X2,"¦ ¦¦--L¦ ")
setcolor(CLR)
L_showcurs()
return 0
1.2.4. Функция вывода строки подсказки
FUNCTION _NORT
static NORTSCR
parameters BINSTR,NUM
private CL,ROW,COL
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
1.2.5. Функция вывода транспаранта ожидания
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
1.2.6. Функция выбора опции из меню с использованием м анипулятора "Мышь" или клавиатуры.
Синтаксис :
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
1.3. Вспомогательные функции
1.3.1. Функция переключения вида курсора
FUNCTION FINS
FINSERT=.not.FINSERT
readinsert(FINSERT)
if setcursor()<>0
CUR_STYLE=iif(FINSERT,2,1)
setcursor(CUR_STYLE)
endif
clear type
return 0
1.3.2. Функция перевод а строки в верхний регистр
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
1.3.3. Функция контроля выхода
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.
1.3.4. Функция перевода числовой величины в строку «Сумма прописью»
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
1.3.5. Функция построения строки «Суммы прописью»
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
1.3.6. Функция получения псевдонима валюты
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
1.4. Основные функции и процедуры
1.4.1. Головной модуль программы
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
1.4.2. Функция вызова меню «Операции»
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
1.4.3. Функция вызова меню ведения справочников
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
1.4.4. Функция вызова меню «Отчеты»
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
1.4.5. Функция вызова меню «Разное»
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
1.4.6. Функция вызова меню «Установки»
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
1.4.7. Функция вызова меню «Копия данных»
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
1.4.8. Функция - селектор операций
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
1.4.9. Функция регистрации покупки валюты
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
1.4.10. Функция регистрации продажи валюты
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
1.4.11. Функция регистрации конверсии валюты
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
1.4.12. Функция - определитель текущего поля для получения кода и наименования объекта из справочника
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.
1.4.13. Функция вывода суммы покупки прописью
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.
1.4.14. Функция вывода суммы продажи прописью
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.
1.4.15. Функция вычисления суммы операции покупки
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
1.4.16. Функция вычисления суммы операции продажи
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
1.4.17. ФУНКЦИЯ ВЫВОДА списка документов дня
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)
lBrowse := .F.
endcase
lKeyWaiting := .F.
enddo
restscreen(1,0,23,79,SCR)
dbcloseall()
_nort()
return 0
1.5. ФУНКЦИЯ ЗАКРЫТИЯ ОПЕРАЦИОННОГО ДНЯ
Function CloseDay()
if _err(07,05,"Вы действительно желаете закрыть","операционный день ?",""," Да "," Нет ","")<>1
return 0
endif
ArBase=strtran(str(day(MDATE),2)+str(month(MDATE),2)+substr(str(year(MDATE),4),3,2)," ","0")
use (DATROAD+"Operatio")
copy to (ARCROAD+"Op"+ArBase)
delete all
pack
use (DATROAD+"Document")
copy to (ARCROAD+"Do"+ArBase)
delete all
pack
use (DATROAD+"Currency")
copy to (ARCROAD+"Cu"+ArBase)
use (DATROAD+"Kurses")
copy to (ARCROAD+"Ku"+ArBase)
use (DATROAD+"Codes")
copy to (ARCROAD+"Co"+ArBase)
ODATE=MDATE
SCR=savescreen(07,05,12,47)
_open_n(07,05,10,45,B_SINGLE+" ",AT_G_F)
CL=setcolor(AT_G_U)
@ 08,22 say ODATE
do while(.T.)
setcolor(AT_G_N+","+AT_G_S+",,,"+AT_G_U)
@ 08,07 say "Текущая дата :"
@ 09,07 say " Новая дата :" get MDATE
setcursor(CUR_STYLE)
read
setcursor(0)
if _err(10,15,"Дата введена правильно?","",""," Да "," Нет ","")=1
save all like MDATE to d
exit
endif
enddo
dbcloseall()
restscreen(07,05,12,47,SCR)
setcolor(CL)
return 0
© Реферат плюс
