box04.prg

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

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


 PARAMETER BDATNAME , XMKNAME
 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 18 , 90 COLOR SCHEME 3 FLOAT TITLE  ;
      '数据录入/修改--' + IIF(LEN(ALLTRIM(XSYK)) <> 0,XSBM + '--' + XSYK,XSBM) + '--' +  ;
XSLX + '--' + XSDQ + '----- ESC 退出'  ;
      IN SCREEN DOUBLE
 ACTIVATE WINDOW WINM
 DEFINE WINDOW WINB04_1 FROM 5 , 0 TO 12 , 79 COLOR SCHEME 2 IN WINM
 DEFINE WINDOW WINB04_2 FROM 3 , 0 TO 6 , 23 COLOR SCHEME 2 IN WINM
 DEFINE WINDOW WINB04_3 FROM 3 , 23 TO 6 , 79 COLOR SCHEME 2 IN WINM
 TCPD = 0
 M_99 = ''
 QPP = 100
 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 WINB04_3
 @ 0 , 1 SAY '项目名称:'
 ACTIVATE WINDOW WINB04_1
 N = 0
 @ N + 0 , 0 SAY  ;
      '┏━━━━━━━┯━━━━━━━━━━┯━━━━━━━┯━━━━━━━━━━┓'
 @ N + 1 , 0 SAY  ;
      '┃              │                    │              │                    ┃'
 @ N + 2 , 0 SAY  ;
      '┠───────┼──────────┼───────┼──────────┨'
 @ N + 3 , 0 SAY  ;
      '┃              │                    │              │                    ┃'
 @ N + 4 , 0 SAY  ;
      '┗━━━━━━━┷━━━━━━━━━━┷━━━━━━━┷━━━━━━━━━━┛'
 X = 1
 YY = 18
 DAXQIN = ''
 M_SHU = 0
 NN = 1
 WW = 1
 QQ = 11
 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'
 SELECT (XMKNAME)
 GO TOP
 M_XMDH = '000000'
 DHX = '      '
 DO WHILE .T.
 ACTIVATE WINDOW WINB04_2
 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 '      '
 @ 0 , 12 SAY DHX
 ACTIVATE WINDOW WINB04_3
 @ 0 , 10 SAY XMMC
 ACTIVATE WINDOW WINB04_2
 DO WHILE .T.
 S_TMP = INKEY('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
 ACTIVATE WINDOW WINB04_3
 @ 0 , 10 SAY XMMC
 ACTIVATE WINDOW WINB04_2
 CASE S_TMP = 13
 IF DHX = '999999'
 DEACTIVATE WINDOW WINB04_1 , WINB04_2 , WINB04_3
 RELEASE WINDOW WINB04_1 , WINB04_2 , WINB04_3 , WINM
 RETURN 
 ENDIF 
 M_DHX_M = 0
 EXIT 
 CASE S_TMP = 27
 DEACTIVATE WINDOW WINB04_1 , WINB04_2 , WINB04_3
 RELEASE WINDOW WINB04_1 , WINB04_2 , WINB04_3 , 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
 DO ACCDAT
  IF &XMKNAME->HDBZ = .T.
 DO src\prg\DPcl3 WITH BDATNAME
 ENDIF 
 DO CLECRTB4
 ENDSCAN 
 ELSE 
 ?? CHR(7)
 WAIT WINDOW '本行数据不录入'
 ENDIF 
 ENDSCAN 
 IF M_XMDH <> DHX
 ?? CHR(7)
 WAIT WINDOW '无此代号'
 ENDIF 
 ENDDO 
 DEACTIVATE WINDOW WINB04_1 , WINB04_2 , WINB04_3
 RELEASE WINDOW WINB04_1 , WINB04_2 , WINB04_3
 DO src\prg\JSCL WITH M_BH , M_BLX1 , M_BLX2 , KKK_NIAN , YUE , M_DQDH
 RETURN 

PROCEDURE ACCDAT
 ACTIVATE WINDOW WINB04_3
  @0,10 SAY &xmkname->XMMC
 ACTIVATE WINDOW WINB04_1
 DO src\prg\lrpd
 @ N + 1 , 18 SAY DA1 PICTURE M_99
 @ N + 1 , 56 SAY DA2 PICTURE M_99
 @ N + 3 , 18 SAY DA3 PICTURE M_99
 @ N + 3 , 56 SAY DA4 PICTURE M_99
 @ 1 , 18 SAY ''
 DO WHILE .T.
 M_TMP = INKEY('MS')
 IF  .NOT. NN > 4
 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
 ENDCASE 
 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 
 X = 1
 YY = 18
 NN = 1
 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 
 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(NN))
  REPLACE &dax WITH VAL(DAXQIN)/qpp
 DAXQIN = ''
  @ X,YY say &dax PICT m_99
 ELSE 
 DAX = 'da' + LTRIM(STR(NN + 1))
 ENDIF 
 NN = NN + 1
 DO CASE 
 CASE X = 1 AND YY = 18
 YY = 56
 WW = 2
 CASE X = 1 AND YY = 56
 X = 3
 YY = 18
 WW = 3
 CASE X = 3 AND YY = 18
 YY = 56
 WW = 4
 ENDCASE 
ENDPROC
*------
PROCEDURE CLECRTB4
 ACTIVATE WINDOW WINB04_3
 @ 0 , 10 SAY SPACE(67)
 ACTIVATE WINDOW WINB04_1
 @ N + 1 , 18 SAY '                    '
 @ N + 1 , 57 SAY '                   '
 @ N + 3 , 19 SAY '                   '
 @ N + 3 , 57 SAY '                   '
ENDPROC
*------*