. , , ,

,,,

TOC o "1-3" 堠 GOTOBUTTON _Toc378670594 PAGEREF _Toc378670594 5

ࠠ GOTOBUTTON _Toc378670595 PAGEREF _Toc378670595 6

- GOTOBUTTON _Toc378670596 PAGEREF _Toc378670596 8

GOTOBUTTON _Toc378670597 PAGEREF _Toc378670597 8

蠠 GOTOBUTTON _Toc378670598 PAGEREF _Toc378670598 9

堠 GOTOBUTTON _Toc378670599 PAGEREF _Toc378670599 9

⠠ GOTOBUTTON _Toc378670600 PAGEREF _Toc378670600 10

GOTOBUTTON _Toc378670601 PAGEREF _Toc378670601 10

. GOTOBUTTON _Toc378670602 PAGEREF _Toc378670602 11

GOTOBUTTON _Toc378670603 PAGEREF _Toc378670603 13

Ϡ GOTOBUTTON _Toc378670604 PAGEREF _Toc378670604 13

. GOTOBUTTON _Toc378670605 PAGEREF _Toc378670605 15

. GOTOBUTTON _Toc378670606 PAGEREF _Toc378670606 16

. GOTOBUTTON _Toc378670607 PAGEREF _Toc378670607 17

. GOTOBUTTON _Toc378670608 PAGEREF _Toc378670608 17

GOTOBUTTON _Toc378670609 PAGEREF _Toc378670609 17

. GOTOBUTTON _Toc378670610 PAGEREF _Toc378670610 20

, . GOTOBUTTON _Toc378670611 PAGEREF _Toc378670611 22

. GOTOBUTTON _Toc378670612 PAGEREF _Toc378670612 26

. GOTOBUTTON _Toc378670613 PAGEREF _Toc378670613 26

. GOTOBUTTON _Toc378670614 PAGEREF _Toc378670614 27

GOTOBUTTON _Toc378670615 PAGEREF _Toc378670615 29

ࠠ GOTOBUTTON _Toc378670616 PAGEREF _Toc378670616 29

ࠠ GOTOBUTTON _Toc378670617 PAGEREF _Toc378670617 31

ࠠ GOTOBUTTON _Toc378670618 PAGEREF _Toc378670618 32

. GOTOBUTTON _Toc378670619 PAGEREF _Toc378670619 32

頠 GOTOBUTTON _Toc378670620 PAGEREF _Toc378670620 33

GOTOBUTTON _Toc378670621 PAGEREF _Toc378670621 33

GOTOBUTTON _Toc378670622 PAGEREF _Toc378670622 35

蠠 GOTOBUTTON _Toc378670623 PAGEREF _Toc378670623 36

GOTOBUTTON _Toc378670624 PAGEREF _Toc378670624 37

堠 GOTOBUTTON _Toc378670625 PAGEREF _Toc378670625 39

GOTOBUTTON _Toc378670626 PAGEREF _Toc378670626 39

蠠 GOTOBUTTON _Toc378670627 PAGEREF _Toc378670627 40

GOTOBUTTON _Toc378670628 PAGEREF _Toc378670628 40

Р GOTOBUTTON _Toc378670629 PAGEREF _Toc378670629 40

GOTOBUTTON _Toc378670630 PAGEREF _Toc378670630 40

޻ GOTOBUTTON _Toc378670631 PAGEREF _Toc378670631 41

GOTOBUTTON _Toc378670632 PAGEREF _Toc378670632 41

MAIN GOTOBUTTON _Toc378670633 PAGEREF _Toc378670633 41

ɠ GOTOBUTTON _Toc378670634 PAGEREF _Toc378670634 44

۠ GOTOBUTTON _Toc378670635 PAGEREF _Toc378670635 44

- GOTOBUTTON _Toc378670636 PAGEREF _Toc378670636 46

. GOTOBUTTON _Toc378670637 PAGEREF _Toc378670637 46

. GOTOBUTTON _Toc378670638 PAGEREF _Toc378670638 46

. GOTOBUTTON _Toc378670639 PAGEREF _Toc378670639 47

. GOTOBUTTON _Toc378670640 PAGEREF _Toc378670640 47

. GOTOBUTTON _Toc378670641 PAGEREF _Toc378670641 48

. GOTOBUTTON _Toc378670642 PAGEREF _Toc378670642 52

堠 GOTOBUTTON _Toc378670643 PAGEREF _Toc378670643 56

堠 GOTOBUTTON _Toc378670644 PAGEREF _Toc378670644 57

蠠 GOTOBUTTON _Toc378670645 PAGEREF _Toc378670645 57

GOTOBUTTON _Toc378670646 PAGEREF _Toc378670646 57

ߠ GOTOBUTTON _Toc378670647 PAGEREF _Toc378670647 57

ߠ GOTOBUTTON _Toc378670648 PAGEREF _Toc378670648 59

GOTOBUTTON _Toc378670649 PAGEREF _Toc378670649 60

ޠ GOTOBUTTON _Toc378670650 PAGEREF _Toc378670650 61

Ƞ GOTOBUTTON _Toc378670651 PAGEREF _Toc378670651 61

ߠ GOTOBUTTON _Toc378670652 PAGEREF _Toc378670652 62

̠ "" . GOTOBUTTON _Toc378670653 PAGEREF _Toc378670653 62

蠠 GOTOBUTTON _Toc378670654 PAGEREF _Toc378670654 66

GOTOBUTTON _Toc378670655 PAGEREF _Toc378670655 66

ߠ Р GOTOBUTTON _Toc378670656 PAGEREF _Toc378670656 66

GOTOBUTTON _Toc378670657 PAGEREF _Toc378670657 66

޻ GOTOBUTTON _Toc378670658 PAGEREF _Toc378670658 67

޻ GOTOBUTTON _Toc378670659 PAGEREF _Toc378670659 68

۠ GOTOBUTTON _Toc378670660 PAGEREF _Toc378670660 69

GOTOBUTTON _Toc378670661 PAGEREF _Toc378670661 69

۠ GOTOBUTTON _Toc378670662 PAGEREF _Toc378670662 69

Ȼ GOTOBUTTON _Toc378670663 PAGEREF _Toc378670663 73

  GOTOBUTTON _Toc378670664 PAGEREF _Toc378670664 73

ۻ GOTOBUTTON _Toc378670665 PAGEREF _Toc378670665 74

Ż GOTOBUTTON _Toc378670666 PAGEREF _Toc378670666 74

Ȼ GOTOBUTTON _Toc378670667 PAGEREF _Toc378670667 75

ջ GOTOBUTTON _Toc378670668 PAGEREF _Toc378670668 76

- ɠ GOTOBUTTON _Toc378670669 PAGEREF _Toc378670669 77

۠ GOTOBUTTON _Toc378670670 PAGEREF _Toc378670670 77

۠ GOTOBUTTON _Toc378670671 PAGEREF _Toc378670671 79

۠ GOTOBUTTON _Toc378670672 PAGEREF _Toc378670672 81

- GOTOBUTTON _Toc378670673 PAGEREF _Toc378670673 82

ޠ GOTOBUTTON _Toc378670674 PAGEREF _Toc378670674 83

ޠ GOTOBUTTON _Toc378670675 PAGEREF _Toc378670675 83

Ƞ GOTOBUTTON _Toc378670676 PAGEREF _Toc378670676 83

Ƞ GOTOBUTTON _Toc378670677 PAGEREF _Toc378670677 84

ߠ GOTOBUTTON _Toc378670678 PAGEREF _Toc378670678 84

ߠ GOTOBUTTON _Toc378670679 PAGEREF _Toc378670679 86

ࠠ GOTOBUTTON _Toc378670680 PAGEREF _Toc378670680 87


IBM - IBM PC, , , , , . .

. , IBM- . XT, AT i286, i386, i486 , , Pentium.

, . , . 5-6 . , , , .

, , - . - . 90-93 .. , , - , . , , Oracle, Gupta . , , . , . , . , , , .

, , . , 500 2000 , - 11500 . , .

- - . 27 27 1995 .

, , . - . .

, , , - . :

      ;

      ;

      () .

- .0406007, . , . . ( ) - ( ) , . .

-

- , . , , . .

, - :

      ;

      ( - , ) ;

      ;

      ;

      , ;

      ;

      , ;

      , , .

:

      ;

      ( , ..);

      .

. , - . , , . .

, , . . , (, ..). . , .

. ( , .) . . :

      ;

      ;

      ( );

      .

27 ...

, . - .

.

, :

      () .

___ =_*_

__=__/_

, ,

      . 0406007 .

, . , . .0406007 .1.

:

     

     

     

      (, ..)

     

     

      /

. 1 -

1-, 2-, 3-, 4- , , 5- ,

6- ,7- , 8- /, 9,13- , 10,14- , 11,15-, 12,16-

     

     

     

     

     

     

     

     

     

() / . , , -. -, , .

__1=__2*_

:

100 - USD-DEM 1,51

100*1,51=151DEM

- , .. USD-DEM, :

__2=__1*(1/_)

:

100 - USD-DEM 1,51

100*(1/1,51)=66,2USD

.

, , . :

      , ;

      , ;

      () ;

()

(

()

( )

(

,

)

( )

( )

,

___________________________________________________________

( ,

)

______________________________________________________

1

2

3

4

5

6

7

():

____________________________________________( )

()

,

          

          

          

          

          

          

          

.

, , , .

.

.

. INTEL. PC/AT 386 Pentium . PC/ , - , - . . , , , ( ..) .

.

, :

      ;

      ;

      ;

      ;

      ;

      .

- DOS Windows.

, , , Delphi, Dbase 5, VisualBasic 4 (Windows) Clipper, Fox Pro, Clarion (DOS). Windows, , DOS , .

DOS-. , Windows, , .. . Windows . , DOS- Windows - .

.

, , DOS. Fox Pro Clipper.

, : Dbase IV CDX. , Clipper . CA-Clipper 5.02 Computer Associates International, Inc.

.

. .1 , .


1

FAM

Char

15

NAME

Char

15

SNAME

Char

15

CDOC

Char

10

DSER

Char

7

DNOM

Num

6

0

REZIDENT

Logical

1

/

BCODC

Num

3

0

BNAMEC

Char

20

0

BCODCUR

Num

3

0

BNAMECUR

Char

20

0

BSUM

Num

15

2

SCODC

Num

3

0

SNAMEC

Char

20

0

SCODCUR

Num

3

0

SNAMECUR

Char

20

0

SSUM

Num

15

2

SSER

Num

2

0

SNOM

Num

6

0

DATA

Date

8

, , .

      , , .

      (), , , , . . .

      . , .

. :

      ;

      ;

      ;

      .

, . :

      ;

      ;

      ;

      ;

      ;

      ;

      ;

      ;

, . , , , 5500 1 . , , . , 1 20 , 20.

, , - , , .

.

: () , , , . . 2-6.

2.

FIO

Char

35

, ,

CDOC

Num

3

DSER

Char

7

DNOM

Num

6

0

REZIDENT

Logical

1

/

BCODC

Num

3

0

BCODCUR

Num

3

0

BSUM

Num

15

2

SCODC

Num

3

0

SCODCUR

Num

3

0

SSUM

Num

15

2

SSER

Num

2

0

SNOM

Num

6

0

DATA

Date

8

3

COD

Num

3

0

NAME

Char

25

4

COD

Num

3

0

NAME

Char

25

BKURS

Num

10

2

SKURS

Num

10

2

CKURS

Num

10

2

SHORT_NAME

Char

3

SCALE

Num

4

0

5

COD

Num

3

0

NAME

Char

25

6

COD

Num

3

0

NAME

Char

25

BKURS

Num

10

2

SKURS

Num

10

2

CKURS

Num

10

2

SHORT_NAME

Char

3

SCALE

Num

4

0

DATA

Date

8

TIME

Char

5

, .

. - . Clipper, , ( )

SET RELATION.

SET RELATION , , . , . . , , "" (.F.).

. , SEEK. , , GOTO.

.

. :

      ;

      .

. , . , . , , .

- . , , : . . : , . , , . , , . .

. . : () . - . (+) . . .

.2

.

, , . , .

.

1)          

                   

                   

                   

                   

2)          

                   

                   

3)          

                   

                   

                   

                   

4)          

                    , ;

                    , ;

                    () ;

5)          

                   

                    ( )

                   

                   

, , .

.

. , , . - . . , , . , , 2.

, . , , - . , . - , , ( ), , . .

.4 Norton Comander


, , . ( DOS-), . Borland, Norton, Symantec. , . : . , (Borland), (Symantec).

5. Borland C++

. , , , ..

, . , , . , , , . . Norton , Borland , . .4,5.

, Borland. , .

CA-Clipper , , , , , , .. , , , , . , , .

, , :

     

     

     

     

     

     

     

     

     

, , . , .

.

. :

     

     

     

     

     

, , . ( ) .

:

     

     

     

     

     

     

.

1. 

2. 

3. 

4. 

5. 

6. 

7. 

8. 

: , , , . - , , , (.6)


.6

7.

, , , ,

.8

. :

     

     

     

     

, BOX, CLEAR .. YL,XL - , YR,XR - . , , . . .

1=(R-XL)/2, Y1=(YR-YL)/2 .

- , , . , , .

.9

, . 1000001001, , 1, 7 10, . , , 6 . .

, , , . . , .

, :

     

     

     

     

     

)

     

     

)

)

.10 .

- - , - .

-, .

.

.

. - . :

     

.11

     

     

.

..., , . , , . .

.12

. , 1 2. Insert SET KEY.

Clipper 5.02 Upper, , . - . . , .

. , .

޻

, . , . . . . , , . - ( 000 002)

:

123456 048

DEM

52567478

. 00 .

MAIN

, - Public. , . Clipper, , , , ..

, . , . :

     

     

     

     

     

     

, , . +GR/B, SETCOLOR. memo - .

.13 ( MAIN)


.14

. . .. , . : . (. ). , , - .

- (. ).

.15 -

. 16 ()

.

: , F3. . .15 .

-

. GETACTIVE, GET-. , . .

.

- .

:

           

           

           

.

. (, ) , . , , . , . , . , . , . .

.

, . . . , , , , . , . - , .

.

. , - . . , , , , .

, , , .

.

. :

, , - , ;

, , , ;

, ;

;

, .

, , . , .

, , . , . .

. , . , . , , , .

.

.

, , , .

, , , , , , , .. , , , , .

, , , , , . , .

, , , (), - . , .

, , . , , . , . , -, , , , . , 60 ( ). , , , , , - , , . , , , 60 , , , . , . , , , .

. , , 20 , 80% , . , , , , 7 , 70% , .

( , , , ) , , .

, , , , : , . , , . , , , ( , , ..). , , , . - .

() , , .

. , , . :

     

     

     

     

, :

     

     

     

     

     

     

     

     

     

     

     

     

     

      - .

, , , , . , , .

- . - , , . , .

. - , . . , , , , .

, , .

.

:

,

[ ]

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

:

,

[ ],[ ]

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

YC2=iif(YC2+2>Y2,Y2,YC2+2)

if XT=X1

exit

endif

XT=iif(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

inkey()

enddo

endif

endif

_open_t(Y1,X1,Y2,X2,S1)

setcolor(CL)

return 0


:

,

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

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

@ YCOR,XUSE+1,YCOR,XCOR+LENG BOX "---------"

endif

csetall(STATS)

setcolor(CLR)

@ RW,CL SAY ""

return 0

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

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

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]

//

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)

lBrowse := .F.

endcase

lKeyWaiting := .F.

enddo

restscreen(1,0,23,79,SCR)

dbcloseall()

_nort()

return 0

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

1.     CA-Clipper 5.02 Users Guide - Clipper

2.     .. FoxPro. . ( . 1993.)

3.     RS-Club 1-7 1996. (Miktor Ky. Union Publisher Inc. 1996.)

4.     ., . ++ Windows ( 1993.)

5.     , - 27 27.02.1995.

TOC o "1-3" 堠 GOTOBUTTON _Toc378670594 PAGEREF _Toc378670594 5 ࠠ

 

 

 

! , , , .
. , :