box03.prg

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

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BOX03.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 14 , 88 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 1 , 3
 ACTIVATE WINDOW WINM
 DEFINE WINDOW WIN31 FROM 2 , 0 TO 9 , 65 FONT 'Courier' , 12 COLOR SCHEME 3 IN WINM
 DEFINE WINDOW WIN32 FROM 0 , 0 TO 2 , 29 FONT '宋体' , 12 COLOR SCHEME 3 IN WINM
 DEFINE WINDOW WIN33 FROM 0 , 29 TO 2 , 65 FONT '宋体' , 12 COLOR SCHEME 3 IN WINM
 TCPD = 0
 M_XMDH = ''
 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 
 N = 0
 SELECT BLK
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da3'
 IF FIELD_TYPE = 'n' .OR. FIELD_TYPE = 'N'
 XXXXD = 'N'
 ACTIVATE WINDOW WIN31
 @ 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 '┗━━━━━━━━┷━━━━━━━━━━━━━━━━━┛ '
 SELECT BLK
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da1'
 @ N + 1 , 2 SAY ALLTRIM(LHY)
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da2'
 @ N + 3 , 2 SAY ALLTRIM(LHY)
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da3'
 @ N + 5 , 2 SAY ALLTRIM(LHY)
 ELSE 
 XXXXD = 'C'
 ACTIVATE WINDOW WIN31
 @ N + 0 , 0 SAY '┏━━━━━━━━┯━━━━━━━━━━━━━━━━━┓ '
 @ N + 1 , 0 SAY '┃                │                                  ┃ '
 @ N + 2 , 0 SAY '┠────────┼─────────────────┨ '
 @ N + 3 , 0 SAY '┃                │                                  ┃ '
 @ N + 4 , 0 SAY '┖────────┴─────────────────┚ '
 SELECT BLK
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da1'
 @ N + 1 , 2 SAY ALLTRIM(LHY)
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da2'
 @ N + 3 , 2 SAY ALLTRIM(LHY)
 LOCATE FOR BH = M_BH AND FIELD_NAME = 'da3'
 @ N + 5 , 2 SAY ALLTRIM(LHY)
 ENDIF 
 X = 1
 NN = 1
 M_SHU = 0
 QQ = 0
 DAXQIN = ''
 SS = 0
 ACTIVATE WINDOW WIN33
 SELECT (XMKNAME)
 GO TOP
 M_XMDH = '000000'
 DHX = '      '
 DO WHILE .T.
 ACTIVATE WINDOW WIN32
 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 WIN33
 @ 0 , 1 SAY '项目名称:'
 @ 0 , 10 SAY XMMC
 ACTIVATE WINDOW WIN32
 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 WIN33
 @ 0 , 10 SAY XMMC
 ACTIVATE WINDOW WIN32
 CASE S_TMP = 13
 IF DHX = '999999'
 DEACTIVATE WINDOW WIN31 , WIN32 , WIN33
 RELEASE WINDOW WIN31 , WIN32 , WIN33 , WINM
 RETURN 
 ENDIF 
 M_DHX_M = 0
 EXIT 
 CASE S_TMP = 27
 DEACTIVATE WINDOW WIN31 , WIN32 , WIN33
 RELEASE WINDOW WIN31 , WIN32 , WIN33 , 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 WIN33
 @ 0 , 1 SAY '项目名称:'
  @0,10 SAY &xmkname->XMMC
 ACTIVATE WINDOW WIN31
 IF XXXXD = 'N'
 DO ACCDAT1
 @ 1 , 26 SAY '                    '
 @ 3 , 26 SAY '                    '
 @ 5 , 26 SAY '                    '
 ELSE 
 DO ACCDAT2
 @ 1 , 26 SAY '                    '
 @ 3 , 26 SAY '                    '
 @ 6 , 0 SAY SPACE(66)
 @ 7 , 0 SAY SPACE(66)
 ENDIF 
 ENDSCAN 
 ELSE 
 ?? CHR(7)
 WAIT WINDOW '本行数据不录入'
 ENDIF 
 ENDSCAN 
 IF  .NOT. M_XMDH = DHX
 ?? CHR(7)
 WAIT WINDOW '无此代号'
 ENDIF 
 ENDDO 
 DEACTIVATE WINDOW WIN31 , WIN32 , WIN33
 RELEASE WINDOW WIN31 , WIN32 , WIN33 , WINM
 DO src\prg\JSCL WITH M_BH , M_BLX1 , M_BLX2 , KKK_NIAN , YUE , M_DQDH
 RETURN 

PROCEDURE ACCDAT1
 DO src\prg\lrpd
 SELECT (BDATNAME)
 @ 1 , 26 SAY DA1 PICTURE M_99
 @ 3 , 26 SAY DA2 PICTURE M_99
 @ 5 , 26 SAY DA3 PICTURE M - 99
 @ 1 , 22 SAY ''
 DO WHILE .T.
 M_TMP = INKEY('MS')
 IF SS = 3 .OR. SS = 5
 SS = 0
 @ X , 22 SAY ''
 ENDIF 
 IF  .NOT. NN > 3
 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 
 NN = 1
 X = 1
 RETURN 
ENDPROC
*------
PROCEDURE ACCDAT2
 DO src\prg\lrpd
 SELECT (BDATNAME)
 @ 1 , 26 SAY DA1 PICTURE M_99
 @ 3 , 26 SAY DA2 PICTURE M_99
 @ 6 , 0 SAY DA3
 @ 1 , 22 SAY ''
 DO WHILE .T.
 M_TMP = INKEY('MS')
 IF SS = 3
 SS = 0
 @ X , 22 SAY ''
 ENDIF 
 IF  .NOT. NN > 2
 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 
 @ 6 , 0 GET DA3
 READ 
 NN = 1
 X = 1
 RETURN 
ENDPROC
*------
PROCEDURE M_SHUZI
 IF X = 1
 IF M_SHU < M_LEN1 - 1
 @ X , 22 SAY '                        '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , 22 SAY DAXQIN
 ELSE 
 ?? CHR(7)
 ENDIF 
 ELSE 
 IF M_SHU < M_LEN2 - 1
 @ X , 22 SAY '                        '
 M_SHU = M_SHU + 1
 QQ = 22
 DAXQIN = DAXQIN + CHR(M_TMP)
 @ X , 22 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)
 @ X , 22 SAY '                   '
 @ X , 22 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 , 22 SAY '                        '
  @ X,26 say &dax PICT m_99
 ENDIF 
 X = X + 2
 NN = NN + 1
 SS = X
ENDPROC
*------*