364 , , : , , , , , , . , , , .
:
364150
(304)
(123)
(23)
(113)
(4)
(4814)
(5227)
(2616)
(3423)
(4214)
(1518)
(68)
- (2836)
(8269)
(50)
(50)
(762)
(2)
(5275)
(30)
(1222)
(43)
(20403)
(465)
(19)
(108)
(173)
(96)
(899)
(54)
(34)
(476)
(106)
(62792)
(3562)
, (6444)
(2165)
(21320)
(766)
(64)
(3145)
(60)
(17)
(588)
(1000)
(106)
(48)
(3)
(1167)
(8485)
(537)
: (2044)
(11657)
(532)
(21)
(7985)
(3721)
, (10549)
(88)
(58)
(36)
(2257)
(12491)
(91)
(797)
(1338)
(24)
, (214)
(1141)
(3)
(8)
(21697)
(7850)
(3801)
(682)
, (2881)
(475)
(1)
, (7100)
(8694)
, (4121)
(443)
(952)
(2967)
(23)
(748)
(4876)
(95)
(107)
(7)
(2004)
(15)
(663)
(240)
(39)
(25)
(624)
(16)
(2652)
(136)
(90)
(406)
(95)
(24)
(3463)
(4482)
(7216)
(4592)
(5386)
(3)
(2244)
(23)
(29)
(35)
(4517)
(20645)
- (666)
(119)
(2573)
(889)
(288)
(148)
, (1140)

:

:
: ,
: 22:42:59 22 2005
: 607 : 2 : 0 : 0 :    

94

5

6

- 8

8

9

10

10

11

. 11

15

15

. 17

. 18

. 19

. 20

20

. 23

, . 25

. 31

. 31

. 32

34

34

36

37

. 37

38

38

40

42

42

44

45

45

45

45

46

╚ ╩ 46

47

MAIN 47

49

50

- 54

. 54

. 54

. 55

. 55

. 56

. 57

62

63

63

63

64

65

66

67

67

68

"" . 68

72

72

72

72

╚ ╩ 73

╚ ╩ 74

75

76

76

╚╩ 79

80

╚╩ 80

╚╩ 81

╚╩ 81

╚ ╩ 83

- 83

84

85

87

- 89

89

90

90

90

91

92

93

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

():

____________________________________________( )

()

,

1 .

2 .

3 .

4 .

5 " . N 0406007".

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.

1.

2.

3.

4.

2.

1.

2.

3.

1.

2.

3.

4.

4.

, ;

, ;

1. () ;

2.

1.

2. ( )

3.

4.

, , .

.

. , , . - . . , , ╚╩ ╚╩ . , , 2.

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

.4 Norton Comander



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

5. Borland C++


. , , , ..

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

, Borland. , .

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

, , :

, , . , .

.

. :

.

, Д , Ô. ( ) .

:

, ,

, 0 Escape

,

,

Ӕ

ݔ.

.

1. (Logic)

2. (Array)

3. (Array)

4. (Array)

5. (Numeric)

6. (String)

7. (String)

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 . .

, , , . . , .

, :

1

2

3

1

)

2

3

)

)

.10 .

- - , - .

-╚╩, .

.

.

. - . :

100%

.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% , .

( , , , ) , , .

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

() , , ͔ .

. , , . :

;

;

;

.

, :

, - , , , ;

14 (Hi-Resolution, Non-Interlaced, Low-Radiation);

70-72;

, ;

70 ;

, ;

;

, 2/3 ;

, ;

1.2;

, ;

50% ;

10 ( 1500 );

15- 2 , - .

, , , , . , , .

- є . - , , . , .

. - , . . , , , , .

, , .

.

:

,

[ ]

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<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, 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<LENG

@ 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.

/
:
? : letsdoit777.blogspot.com
22:10:13 18 2016
9000 " "? : business1777.blogspot.com ! C !
13:24:42 24 2015

, :



, ?

, .
, .
, .
, .
, .



(151041)
(1843)
Copyright 2005-2016 BestReferat.ru bestreferat@mail.ru

@Mail.ru