box02.prg

使用VFP编写的信用社系统专用会计报表系统,可上报,汇总,打印.是一款优秀的信用社会计报表系统

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BOX02.PRG <-- 本文件由 UnFoxAll 创建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


 PARAMETER BDATNAME , XMKNAME
 SET ESCAPE OFF
 SET COLOR OF SCHEME 2 TO  GR+/BG,W+/BG,GR/BG,GR/BG,GR+/B,GR+/B,GR+/W,R+/N,N/N,W/N,N+/N
 SET COLOR OF SCHEME 3 TO RGB( 0 , 0 , 0 , 192 , 192 , 192) ,  ;
       W+/BG,GR/BG,GR/BG,GR+/B,GR+/B,GR+/W,R+/N,N/N,W/N,N+/N
 DEFINE WINDOW WINM FROM 1 , 1 TO 16 , 120 FONT 'Courier' , 12 COLOR SCHEME 3 FLOAT  ;
      TITLE  ;
      '数据录入/修改--' + IIF(LEN(ALLTRIM(XSYK)) <> 0,XSBM + '--' + XSYK,XSBM) + '--' +  ;
XSLX + '--' + XSDQ + '----- ESC 退出' IN SCREEN  ;
      DOUBLE
 MOVE WINDOW WINM TO 1 , 3
 ACTIVATE WINDOW WINM
 DEFINE WINDOW WIN21 FROM 3 , 1 TO 10 , 78 FONT 'Courier' , 12 COLOR SCHEME 3 IN WINM
 DEFINE WINDOW WIN22 FROM 1 , 1 TO 3 , 78 FONT 'Courier' , 12 COLOR SCHEME 3 IN WINM
 TCPD = 0
 GDBLR = ''
 IF M_QZBZ = .T.
 QPP = 1
 M_99 = '9999,999,999,999,999'
 ELSE 
 M_99 = '9,999,999,999,999.99'
 QPP = 100
 ENDIF 
 SELECT BLK
 FOR M = 1 TO M_LS
 DAXA = 'da' + LTRIM(STR(M))
 M_LENX = 'm_len' + LTRIM(STR(M))
 LOCATE FOR BH = M_BH AND FIELD_NAME = DAXA
  &m_lenx=FIELD_len
 ENDFOR 
 ACTIVATE WINDOW WIN21
 N = 0
 @ N + 0 , 0 SAY  ;
      '┏━━━━━━━━━━━━━━┯━━━━━━━━━━┯━━━━━━━━━━┓ '
 @ N + 1 , 0 SAY  ;
      '┃    项    目    名   称     │                    │                    ┃ '
 @ N + 2 , 0 SAY  ;
      '┠──────────────┼──────────┼──────────┨ '
 @ N + 3 , 0 SAY  ;
      '┃                            │                    │                    ┃ '
 @ N + 4 , 0 SAY  ;
      '┠──────────────┼──────────┼──────────┨ '
 @ N + 5 , 0 SAY  ;
      '┃                            │                    │                    ┃ '
 @ N + 6 , 0 SAY  ;
      '┗━━━━━━━━━━━━━━┷━━━━━━━━━━┷━━━━━━━━━━┛ '
 QQ = 11
 YY = 32
 SS = 0
 NN = 1
 M_DA1 = ''
 M_DA2 = ''
 M_SHU = 0
 DAXQIN = ''
 SELECT BLK
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da1'
 @ N + 1 , 38 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da2'
 @ N + 1 , 60 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 SELECT (XMKNAME)
 GO TOP
 M_XMDH = '000000'
 DHX = '      '
 DO WHILE .T.
 ACTIVATE WINDOW WIN22
 SELECT (XMKNAME)
 IF M_XMDH <> '000000'
 LOCATE FOR ALLTRIM(XMDH) == DHX
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 GO TOP
 ENDIF 
 ENDIF 
 DO WHILE .T.
 IF RECCOUNT() < 1
 RETURN 
 ENDIF 
 IF LRBZ = .T. AND UPPER(LEFT(XMDH,1)) <> 'B'
 EXIT 
 ENDIF 
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 GO TOP
 ENDIF 
 ENDDO 
 M_DHX_M = 0
 DHX = ALLTRIM(XMDH)
 @ 0 , 1 SAY '项目代号: '
 @ 0 , 12 SAY '              '
 @ 1 , 12 SAY '              '
 @ 0 , 12 SAY DHX
 DO WHILE .T.
 S_TMP = INKEY(0,'MS')
 DO CASE 
 CASE (S_TMP > 47 AND S_TMP < 58 .OR. S_TMP = 45 .OR. S_TMP > 96 AND S_TMP < 100) AND  ;
M_DHX_M < 6
 IF M_DHX_M = 0
 @ 0 , 12 SAY '              '
 DHX = ''
 ENDIF 
 M_DHX_M = M_DHX_M + 1
 DHX = DHX + CHR(S_TMP)
 @ 0 , 12 SAY DHX
 CASE S_TMP = 127 .OR. S_TMP = 19
 IF M_DHX_M <> 0
 M_DHX_M = M_DHX_M - 1
 DHX = LEFT(DHX,LEN(DHX) - 1)
 @ 0 , 12 SAY '              '
 @ 0 , 12 SAY DHX
 ENDIF 
 CASE S_TMP = 43
 M_DHX_M = 0
 DO WHILE .T.
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 GO TOP
 ENDIF 
 IF LRBZ = .T.
 EXIT 
 ENDIF 
 ENDDO 
 DHX = ALLTRIM(XMDH)
 @ 0 , 12 SAY '              '
 @ 0 , 12 SAY DHX
 CASE S_TMP = 13
 IF DHX = '999999'
 DEACTIVATE WINDOW WIN21 , WIN22
 RELEASE WINDOW WIN21 , WIN22 , WINM
 RETURN 
 ENDIF 
 M_DHX_M = 0
 EXIT 
 CASE S_TMP = 27
 DEACTIVATE WINDOW WIN21 , WIN22
 RELEASE WINDOW WIN21 , WIN22 , WINM
 TCPD = 1
 EXIT 
 ENDCASE 
 ENDDO 
 IF TCPD = 1
 EXIT 
 ENDIF 
 @ 0 , 12 SAY '              '
 @ 0 , 12 SAY DHX
 SELECT (XMKNAME)
 SCAN FOR ALLTRIM(XMDH) == DHX
 M_XMDH = XMDH
 IF LRBZ = .T.
 SELECT (BDATNAME)
 SCAN FOR ALLTRIM(XMDH) == DHX AND DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 ACTIVATE WINDOW WIN21
 DO ACCDAT
 ENDSCAN 
 ELSE 
 ?? CHR(7)
 WAIT WINDOW '本行数据不录入'
 ENDIF 
 ENDSCAN 
 IF M_XMDH <> DHX
 ?? CHR(7)
 WAIT WINDOW '无此代号'
 ENDIF 
 ENDDO 
 DO src\prg\JSCL WITH M_BH , M_BLX1 , M_BLX2 , KKK_NIAN , YUE , M_DQDH
 DEACTIVATE WINDOW WIN21 , WIN22
 RELEASE WINDOW WIN21 , WIN22 , WINM
 RETURN 

PROCEDURE ACCDAT
  @ N+5,2 SAY &XMKNAME->XMMC PICT "XXXXXXXXXXXXXXXXXXXXXX"
 QQQ = 1
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 @ N + 5 , 32 SAY DA1 PICTURE M_99
 ELSE 
 @ N + 5 , 32 SAY '                   '
 YY = 54
 NN = NN + 1
 ENDIF 
 QQQ = 2
 DO src\prg\lrpd
 SELECT (BDATNAME)
 @ N + 5 , 54 SAY DA2 PICTURE M_99
 @ N + 5 , YY SAY ''
 DO WHILE .T.
 IF SS = 54
 SS = 0
 @ N + 5 , YY SAY ''
 ENDIF 
 IF  .NOT. YY > 75
 M_TMP = INKEY(0,'MS')
 DO CASE 
 CASE M_TMP > 47 AND M_TMP < 58 .OR. M_TMP = 45
 DO M_SHUZI
 CASE M_TMP = 127 .OR. M_TMP = 19
 DO M_BSP
 CASE M_TMP = 13
 DO M_ENTER
 ENDCASE 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
  @ N+3,2 SAY &xmkname->xmmc PICT "XXXXXXXXXXXXXXXXXXXXXXXX"
 QQQ = 1
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 @ N + 3 , 32 SAY DA1 PICTURE M_99
 ELSE 
 @ N + 3 , 32 SAY '                    '
 ENDIF 
 QQQ = 2
 DO src\prg\lrpd
 SELECT (BDATNAME)
 @ N + 3 , 54 SAY DA2 PICTURE M_99
 @ N + 5 , 32 SAY '                    '
 @ N + 5 , 54 SAY '                    '
 @ N + 5 , 2 SAY '                            '
 YY = 32
 NN = 1
 RETURN 
ENDPROC
*------
PROCEDURE M_SHUZI
 IF YY = 32
 IF M_SHU < M_LEN1 - 1
 @ N + 5 , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ N + 5 , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 ELSE 
 IF M_SHU < M_LEN2 - 1
 @ N + 5 , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ N + 5 , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE M_BSP
 IF M_SHU <> 0
 M_SHU = M_SHU - 1
 DAXQIN = LEFT(DAXQIN,LEN(DAXQIN) - 1)
 @ N + 5 , YY SAY '                   '
 @ N + 5 , YY SAY DAXQIN
 ENDIF 
ENDPROC
*------
PROCEDURE M_ENTER
 QQQ = NN
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF QQ = 22
 QQ = 11
 M_SHU = 0
 SELECT (BDATNAME)
 DAX = 'da' + LTRIM(STR(NN))
  REPLACE &dax WITH VAL(DAXQIN)/qpp  
 DAXQIN = ''
  @ N+5,YY say &dax PICT m_99
 YY = YY + 22
 SS = YY
 ELSE 
 DAX = 'da' + LTRIM(STR(NN))
 YY = YY + 22
 SS = YY
 ENDIF 
 NN = NN + 1
ENDPROC
*------*