box06.prg

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

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BOX06.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 5 , 20 TO 19 , 140 FONT '宋体' , 12 COLOR SCHEME 3 FLOAT TITLE  ;
      '数据录入/修改--' + IIF(LEN(ALLTRIM(XSYK)) <> 0,XSBM + '--' + XSYK,XSBM) + '--' +  ;
XSLX + '--' + XSDQ + '----- ESC 退出'  ;
      IN SCREEN DOUBLE
 MOVE WINDOW WINM TO 5 , 3
 ACTIVATE WINDOW WINM
 DEFINE WINDOW WIN61 FROM 2 , 0 TO 10 , 90 FONT 'Courier' , 12 COLOR SCHEME 3 IN WINM
 DEFINE WINDOW WIN62 FROM 0 , 0 TO 2 , 25 FONT 'Courier' , 12 COLOR SCHEME 3 IN WINM
 DEFINE WINDOW WIN63 FROM 0 , 25 TO 2 , 90 FONT 'Courier' , 12 COLOR SCHEME 3 IN WINM
 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 WIN63
 @ 0 , 3 SAY '项目名称:'
 ACTIVATE WINDOW WIN61
 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  ;
      '┗━━━━━━━┷━━━━━━━━━━┷━━━━━━━┷━━━━━━━━━━┛'
 DAXQIN = ''
 M_SHU = 0
 QQ = 11
 SS = 0
 NN = 1
 M_DA1 = ''
 M_DA2 = ''
 SELECT BLK
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da1'
 @ N + 1 , 2 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da2'
 @ N + 1 , 40 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da3'
 @ N + 3 , 2 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da4'
 @ N + 3 , 40 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da5'
 @ N + 5 , 2 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da6'
 @ N + 5 , 40 SAY LHY PICTURE 'XXXXXXXXXXXXXX'
 SELECT (XMKNAME)
 GO TOP
 M_XMDH = '000000'
 DHX = '      '
 DO WHILE .T.
 IF MMBZ1 = .F. AND M_YCBZA = .T.
 WW = 3
 X = 3
 YY = 18
 NN = 3
 ELSE 
 X = 1
 YY = 18
 WW = 1
 NN = 1
 ENDIF 
 ACTIVATE WINDOW WIN62
 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.
 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
 ACTIVATE WINDOW WIN63
 @ 0 , 14 SAY XMMC
 ACTIVATE WINDOW WIN62
 DO WHILE .T.
 S_TMP = INKEY('SM')
 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
 ACTIVATE WINDOW WIN63
 @ 0 , 14 SAY XMMC
 ACTIVATE WINDOW WIN62
 CASE S_TMP = 13
 IF DHX = '999999'
 DEACTIVATE WINDOW WIN61 , WIN62 , WIN63
 RELEASE WINDOW WIN61 , WIN62 , WIN63 , WINM
 RETURN 
 ENDIF 
 M_DHX_M = 0
 EXIT 
 CASE S_TMP = 27
 DEACTIVATE WINDOW WIN61 , WIN62 , WIN63
 RELEASE WINDOW WIN61 , WIN62 , WIN63 , WINM
 RETURN 
 ENDCASE 
 ENDDO 
 @ 0 , 12 SAY '             '
 @ 0 , 12 SAY DHX
 SELECT (XMKNAME)
 SCAN FOR ALLTRIM(XMDH) == DHX
 M_XMDH = XMDH
 M_YCBZ = YCBZ
 IF LRBZ = .T.
 SELECT (BDATNAME)
 SCAN FOR ALLTRIM(XMDH) == DHX AND DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 DO ACCDAT
  IF &XMKNAME->HDBZ = .T.
 DO src\prg\DPcl3 WITH BDATNAME
 ENDIF 
 EXIT 
 ENDSCAN 
 DO CLECRT
 ACTIVATE WINDOW WIN63
 @ 0 , 14 SAY SPACE(60)
 ELSE 
 ?? CHR(7)
 WAIT WINDOW '本行数据不录入'
 ENDIF 
 ENDSCAN 
 IF M_XMDH <> DHX
 ?? CHR(7)
 WAIT WINDOW '无此代号'
 ENDIF 
 ENDDO 
 DEACTIVATE WINDOW WIN61 , WIN62 , WIN63
 RELEASE WINDOW WIN61 , WIN62 , WIN63 , WINM
 M_CBJS = 2
 DO src\prg\CBJS
 M_CBJS = 0
 DO src\prg\CBJS
 DO src\prg\JSCL WITH M_BH , M_BLX1 , M_BLX2 , NIAN , YUE , M_DQDH
 RETURN 

PROCEDURE ACCDAT
 ACTIVATE WINDOW WIN63
  @0,14 SAY &xmkname->XMMC
 ACTIVATE WINDOW WIN61
 DO CLECRT
 IF MMBZ1 = .F. AND M_YCBZA = .T.
 QQQ = 3
 DO BLRP
 DO BLRP1
 ELSE 
 @ 1 , 18 SAY ''
 QQQ = 1
 DO BLRP
 DO BLRP1
 ENDIF 
 DO WHILE .T.
 M_TMP = INKEY('MS')
 IF  .NOT. NN > 6 AND  .NOT. QQQ > 6
 DO BLRP1
 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
 NN = QQQ + 1
 DO M_ENTER
 DO BLRP
 ENDCASE 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 RETURN 
ENDPROC
*------
PROCEDURE M_SHUZI
 DO CASE 
 CASE X = 1 AND YY = 18
 IF M_SHU < M_LEN1 - 1
 @ X , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 CASE X = 1 AND YY = 56
 IF M_SHU < M_LEN2 - 1
 @ X , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 CASE X = 3 AND YY = 18
 IF M_SHU < M_LEN3 - 1
 @ X , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 CASE X = 3 AND YY = 56
 IF M_SHU < M_LEN4 - 1
 @ X , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 CASE X = 5 AND YY = 18
 IF M_SHU < M_LEN5 - 1
 @ X , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 CASE X = 5 AND YY = 56
 IF M_SHU < M_LEN6 - 1
 @ X , YY SAY '                    '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , YY SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 ENDCASE 
ENDPROC
*------
PROCEDURE M_BSP
 IF M_SHU <> 0
 M_SHU = M_SHU - 1
 DAXQIN = LEFT(DAXQIN,LEN(DAXQIN) - 1)
 @ X , YY SAY '                   '
 @ X , YY SAY DAXQIN
 ENDIF 
ENDPROC
*------
PROCEDURE M_ENTER
 IF QQ = 22
 QQ = 11
 M_SHU = 0
 SELECT (BDATNAME)
 DAX = 'da' + LTRIM(STR(QQQ))
  REPLACE &dax WITH VAL(DAXQIN)/100  
 DAXQIN = ''
  if &dax>9999999999999.99
  @ x,yy SAY &dax PICT "999999999,999,999.99"
 ELSE 
  @ x,yy SAY &dax PICT "9,999,999,999,999.99"
 ENDIF 
 ELSE 
 DAX = 'da' + LTRIM(STR(QQQ))
 ENDIF 
 DO CASE 
 CASE X = 1 AND YY = 18
 YY = 56
 WW = 2
 QQQ = 2
 CASE X = 1 AND YY = 56
 X = 3
 YY = 18
 WW = 3
 QQQ = 3
 CASE X = 3 AND YY = 18
 YY = 56
 WW = 4
 QQQ = 4
 CASE X = 3 AND YY = 56
 X = 5
 YY = 18
 WW = 5
 QQQ = 5
 IF MMBZ2 = .T. AND M_YCBZ <> 4 AND M_YCBZA = .T. AND M_YCBZ <> 3
 M_DA5 = 0
 M_DA6 = 0
 DO CASE 
 CASE M_YCBZ = 1
 IF M_BH = '26'
 M_DA5 = DA3 - DA1
 ELSE 
 M_DA5 = DA1 + DA3 - DA4 - DA2
 ENDIF 
 CASE M_YCBZ = 2
 IF M_BH = '26'
 M_DA6 = DA4 - DA2
 ELSE 
 M_DA6 = DA2 + DA4 - DA3 - DA1
 ENDIF 
 CASE M_YCBZ = 3
 IF M_BH = '26'
 M_DA5 = DA3 - DA1
 M_DA6 = DA4 - DA2
 ELSE 
 M_DA5 = DA5
 M_DA6 = DA6
 ENDIF 
 ENDCASE 
 REPLACE DA5 WITH M_DA5
 REPLACE DA6 WITH M_DA6
 NN = 7
 IF DA5 > 9999999999999.99
 @ 5 , 18 SAY DA5 PICTURE '999999999,999,999.99'
 ELSE 
 @ 5 , 18 SAY DA5 PICTURE '9,999,999,999,999.99'
 ENDIF 
 IF DA6 > 9999999999999.99
 @ 5 , 56 SAY DA6 PICTURE '999999999,999,999.99'
 ELSE 
 @ 5 , 56 SAY DA6 PICTURE '9,999,999,999,999.99'
 ENDIF 
 WAIT ''
 ENDIF 
 CASE X = 5 AND YY = 18
 YY = 56
 WW = 6
 QQQ = 6
 ENDCASE 
ENDPROC
*------
PROCEDURE CLECRT
 @ N + 1 , 18 SAY '                    '
 @ N + 1 , 56 SAY '                    '
 @ N + 3 , 18 SAY '                    '
 @ N + 3 , 56 SAY '                    '
 @ N + 5 , 18 SAY '                    '
 @ N + 5 , 56 SAY '                    '
 QQQ = 1
 DO .\src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 IF DA1 > 9999999999999.99
 @ N + 1 , 18 SAY DA1 PICTURE '999999999,999,999.99'
 ELSE 
 @ N + 1 , 18 SAY DA1 PICTURE '9,999,999,999,999.99'
 ENDIF 
 ENDIF 
 QQQ = 2
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 IF DA2 > 9999999999999.99
 @ N + 1 , 56 SAY DA2 PICTURE '999999999,999,999.99'
 ELSE 
 @ N + 1 , 56 SAY DA2 PICTURE '9,999,999,999,999.99'
 ENDIF 
 ENDIF 
 QQQ = 3
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 IF DA3 > 9999999999999.99
 @ N + 3 , 18 SAY DA3 PICTURE '999999999,999,999.99'
 ELSE 
 @ N + 3 , 18 SAY DA3 PICTURE '9,999,999,999,999.99'
 ENDIF 
 ENDIF 
 QQQ = 4
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 IF DA4 > 9999999999999.99
 @ N + 3 , 56 SAY DA4 PICTURE '999999999,999,999.99'
 ELSE 
 @ N + 3 , 56 SAY DA4 PICTURE '9,999,999,999,999.99'
 ENDIF 
 ENDIF 
 QQQ = 5
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 IF DA5 > 9999999999999.99
 @ N + 5 , 18 SAY DA5 PICTURE '999999999,999,999.99'
 ELSE 
 @ N + 5 , 18 SAY DA5 PICTURE '9,999,999,999,999.99'
 ENDIF 
 ENDIF 
 QQQ = 6
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 IF DA6 > 9999999999999.99
 @ N + 5 , 56 SAY DA6 PICTURE '999999999,999,999.99'
 ELSE 
 @ N + 5 , 56 SAY DA6 PICTURE '9,999,999,999,999.99'
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE blrp
 DO WHILE QQQ < 7
 DO src\prg\lrpd
 SELECT (BDATNAME)
 IF GDBLR = 'n'
 DO CASE 
 CASE QQQ = 1
 X = 1
 YY = 18
 WW = 1
 CASE QQQ = 2
 X = 1
 YY = 56
 WW = 2
 CASE QQQ = 3
 X = 3
 YY = 18
 WW = 3
 CASE QQQ = 4
 X = 3
 YY = 56
 WW = 4
 CASE QQQ = 5
 X = 5
 YY = 18
 WW = 5
 CASE QQQ = 6
 X = 5
 YY = 56
 WW = 6
 ENDCASE 
 EXIT 
 ENDIF 
 QQQ = QQQ + 1
 ENDDO 
ENDPROC
*------
PROCEDURE blrp1
 DO CASE 
 CASE WW = 2
 @ 1 , 56 SAY ''
 WW = 1
 CASE WW = 3
 @ 3 , 18 SAY ''
 WW = 1
 CASE WW = 4
 @ 3 , 56 SAY ''
 WW = 1
 CASE WW = 5
 @ 5 , 18 SAY ''
 WW = 1
 CASE WW = 6
 @ 5 , 56 SAY ''
 WW = 1
 ENDCASE 
ENDPROC
*------*