shcl2w.prg

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

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



PROCEDURE SHCL2w
 PARAMETER P_BH1 , P_LX1 , P_YEA1 , P_MON1 , P_DH1 , P_DH2
 STORE 0 TO L_DBLS , R_DBLS , LIN , AREA
 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 33 , 120 FONT '宋体' , 12 COLOR SCHEME 3 FLOAT TITLE  ;
      ' 审核数据' IN SCREEN DOUBLE
 MOVE WINDOW WINM CENTER 
 ACTIVATE WINDOW WINM
 LIN = 8
 PATH = '.\DAT\'
 DBF1 = 'B' + P_BH1 + P_YEA1 + P_MON1
 STORE .F. TO BZ , ERR
 STORE SPACE(12) TO BM1
 DO ZHUNBEI
 IF ERR = .T.
 CLEAR 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
 RETURN 
 ENDIF 
 M_SHPCL = 0
 CLEAR 
 STORE 0 TO BUTONG_BH2
 @ 3 , 16 SAY SUBSTR(ALLTRIM(BM1),1,26)
 FOR AREA = VAL(P_DH1) TO VAL(P_DH2)
 @ 1 , 20 SAY '正在审核      地区'
 @ 1 , 30 SAY LTRIM(STR(AREA))
 SELECT DQK
 GO TOP
 LOCATE FOR DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW NOWAIT '地区' + LTRIM(STR(AREA)) + '不存在!'
 LOOP 
 ENDIF 
 IF KHBZ = .F.
 ? CHR(7)
 WAIT WINDOW NOWAIT '地区' + LTRIM(STR(AREA)) + '没开户! '
 LOOP 
 ENDIF 
 STORE 0 TO MAX_XH , MIN_XH
 SELECT FZSH1
 MAX_XH = RECCOUNT()
 FOR MIN_XH = 1 TO MAX_XH
 SELECT FZSH1
 GO TOP
 LOCATE FOR XH = MIN_XH
 IF BH <> P_BH1
 LOOP 
 ENDIF 
 STORE 8 TO LIN
 STORE 0 TO DAT1 , DAT2 , SJDW1
 STORE .T. TO PROC_ERR
 DO GET_L_FORM
 DO GET_R_FORM
 SELECT FZSH1
 SCAN FOR XH = MIN_XH
 DO CHA_GET1
 DO L_COMPUT
 TC_WEI = INKEY()
 IF TC_WEI = 27
 CLOSE DATABASES 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
 RETURN TO MASTER 
 ENDIF 
 IF PROC_ERR = .F.
 EXIT 
 ENDIF 
 ENDSCAN 
 IF PROC_ERR = .F.
 TC_WEI = INKEY()
 IF TC_WEI = 27
 CLOSE DATABASES 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
 RETURN TO MASTER 
 ENDIF 
 LOOP 
 ENDIF 
 @ 19 , 8 SAY '合计 ='
 @ ROW() , COL() SAY DAT1 PICTURE '99,999,999,999,999.99'
 SELECT FZSH2
 STORE 8 TO LIN
 SCAN FOR XH = MIN_XH
 DO CHA_GET2
 DO R_COMPUT
 TC_WEI = INKEY()
 IF TC_WEI = 27
 CLOSE DATABASES 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
 RETURN TO MASTER 
 ENDIF 
 IF PROC_ERR = .F.
 EXIT 
 ENDIF 
 ENDSCAN 
 IF PROC_ERR = .F.
 TC_WEI = INKEY()
 IF TC_WEI = 27
 CLOSE DATABASES 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
 RETURN TO MASTER 
 ENDIF 
 LOOP 
 ENDIF 
 @ 19 , 38 SAY '合计 ='
 @ ROW() , COL() SAY DAT2 PICTURE '99,999,999,999,999.99'
 IF ABS(DAT1 - DAT2) > M_SHPCL
 ? CHR(7)
 WAIT WINDOW '根据这条公式审核不符!'
 ENDIF 
 @ 19 , 15 SAY SPACE(22)
 @ 19 , 44 SAY SPACE(22)
 TC_WEI = INKEY()
 IF TC_WEI = 27
 CLOSE DATABASES 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
 RETURN TO MASTER 
 ENDIF 
 ENDFOR 
 ? CHR(7)
 WAIT WINDOW NOWAIT '地区' + LTRIM(STR(AREA)) + '核对完毕'
 ENDFOR 
 CLOSE DATABASES 
 WAIT WINDOW '全部核对完毕！'
 CLEAR 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
ENDPROC
*------
PROCEDURE ZHUNBEI
  IF !FILE(".\DAT\B&P_BH1&P_YEA1&P_MON1..DAT") 
 ? CHR(7)
  WAIT "数据文件.\DAT\B&P_BH1&P_YEA1&P_MON1..DAT不存在!" WINDOW
 STORE .T. TO ERR
 RETURN 
 ENDIF 
 IF  .NOT. USED('DQK')
 USE IN 0 ('.\LIB\DQK.DAT')
 ENDIF 
 IF  .NOT. USED('BZL')
 USE IN 0 ('.\LIB\BZL.DAT')
 ENDIF 
 SELECT BZL
 GO TOP
 LOCATE FOR BH = P_BH1
 STORE LX TO BZ
 STORE BM TO BM1
 IF  .NOT. USED('FZSH1')
 USE IN 0 '.\LIB\FZSH1.DAT'
 ENDIF 
 IF  .NOT. USED('FZSH2')
 USE IN 0 '.\LIB\FZSH2.DAT'
 ENDIF 
 IF  .NOT. USED(DBF1)
  USE (".\DAT\B&P_BH1&P_YEA1&P_MON1..DAT") IN 0
 ENDIF 
ENDPROC
*------
PROCEDURE L_COMPUT
 L_DBLS = 0
 L_DBLS = LS + 5
  SELE B&P_BH1&P_YEA1&P_MON1
 IF BZ = .T.
 LOCATE FOR XMDH = FZSH1.XMDH AND BLX1 = P_LX1 AND BLX2 = '1' AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH1.XMDH AND BLX1 = P_LX1 AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW NOWAIT TRIM(STR(AREA)) + '数据不存在'
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 ENDIF 
 SCATTER TO L_DAT
 IF SJDW1 = 0
 STORE FZSH1.DW TO SJDW1
 ENDIF 
 CHA = SJDW1 - FZSH1.DW
 L_DAT( L_DBLS ) = ROUND(L_DAT(L_DBLS) / 10 ** CHA,2)
 DO CASE 
 CASE FZSH1.FH = '+'
 DAT1 = DAT1 + L_DAT(L_DBLS)
 CASE FZSH1.FH = '-'
 DAT1 = DAT1 - L_DAT(L_DBLS)
 ENDCASE 
ENDPROC
*------
PROCEDURE R_COMPUT
 R_DBLS = 0
 R_DBLS = LS + 5
 STORE BH TO M_BH2 , BH2
 PAT = '.\DAT\'
 DBF2 = 'B' + M_BH2 + P_YEA1 + P_MON1
  IF !FILE(".\DAT\B&M_BH2&P_YEA1&P_MON1..DAT")
 ? CHR(7)
  WAIT "不存在.\DAT\B&M_BH2&P_YEA1&P_MON1..DAT文件" WINDOW
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
  IF !USED("B&M_BH2&P_YEA1&P_MON1.")
  use .\DAT\B&M_BH2&P_YEA1&P_MON1..DAT IN 0
 ENDIF 
 SELECT BZL
 GO TOP
 LOCATE FOR BH = M_BH2
 STORE LX TO YK
  SELE B&M_BH2&P_YEA1&P_MON1
 IF YK = .T.
 LOCATE FOR XMDH = FZSH2.XMDH AND BLX1 = P_LX1 AND DQDH = AREA AND BLX2 = '1'
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = AREA AND BLX2 = '1'
 IF  .NOT. FOUND()
 ? CHR(7)
  WAIT "表&M_BH2"+LTRIM(STR(AREA))+"地区不存在!!" WINDOW NOWAIT
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH2.XMDH AND BLX1 = P_LX1 AND DQDH = AREA
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
  WAIT "表&M_BH2"+LTRIM(STR(AREA))+"地区不存在!!" WINDOW NOWAIT
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 ENDIF 
 ENDIF 
 SCATTER TO R_DAT
 CHA = SJDW1 - FZSH2.DW
 R_DAT( R_DBLS ) = ROUND(R_DAT(R_DBLS) / 10 ** CHA,2)
 DO CASE 
 CASE FZSH2.FH = '+'
 DAT2 = DAT2 + R_DAT(R_DBLS)
 CASE FZSH2.FH = '-'
 DAT2 = DAT2 - R_DAT(R_DBLS)
 ENDCASE 
ENDPROC
*------
PROCEDURE GET_L_FORM
 @ 4 , 4 SAY '┌──┬─┬───┬─┬─┐'
 @ 5 , 4 SAY '│序  │符│项  目│栏│单│'
 @ 6 , 4 SAY '│  号│号│代  号│数│位│'
 @ 7 , 4 SAY '├──┼─┼───┼─┼─┤'
 @ 8 , 4 SAY '│    │  │      │  │  │'
 @ 9 , 4 SAY '│    │  │      │  │  │'
 @ 10 , 4 SAY '│    │  │      │  │  │'
 @ 11 , 4 SAY '│    │  │      │  │  │'
 @ 12 , 4 SAY '│    │  │      │  │  │'
 @ 13 , 4 SAY '│    │  │      │  │  │'
 @ 14 , 4 SAY '│    │  │      │  │  │'
 @ 15 , 4 SAY '│    │  │      │  │  │'
 @ 16 , 4 SAY '│    │  │      │  │  │'
 @ 17 , 4 SAY '│    │  │      │  │  │'
 @ 18 , 4 SAY '└──┴─┴───┴─┴─┘'
ENDPROC
*------
PROCEDURE GET_R_FORM
 @ 4 , 38 SAY '    ┌─┬─┬───┬─┬─┐'
 @ 5 , 38 SAY '　　│符│表│项  目│栏│单│'
 @ 6 , 38 SAY '＝  │号│号│代  号│数│位│'
 @ 7 , 38 SAY '    ├─┼─┼───┼─┼─┤'
 @ 8 , 38 SAY '    │  │  │      │  │  │'
 @ 9 , 38 SAY '    │  │  │      │  │  │'
 @ 10 , 38 SAY '    │  │  │      │  │  │'
 @ 11 , 38 SAY '    │  │  │      │  │  │'
 @ 12 , 38 SAY '    │  │  │      │  │  │'
 @ 13 , 38 SAY '    │  │  │      │  │  │'
 @ 14 , 38 SAY '    │  │  │      │  │  │'
 @ 15 , 38 SAY '    │  │  │      │  │  │'
 @ 16 , 38 SAY '    │  │  │      │  │  │'
 @ 17 , 38 SAY '    │  │  │      │  │  │'
 @ 18 , 38 SAY '    └─┴─┴───┴─┴─┘'
ENDPROC
*------
PROCEDURE CHA_GET1
 IF LIN > 17
 DO GET_L_FORM
 STORE 8 TO LIN
 ENDIF 
 @ LIN , 12 SAY FH
 @ LIN , 16 SAY XMDH
 @ LIN , 24 SAY LTRIM(STR(LS))
 @ LIN , 28 SAY LTRIM(STR(DW))
 LIN = LIN + 1
ENDPROC
*------
PROCEDURE CHA_GET2
 IF LIN > 17
 DO GET_R_FORM
 STORE 8 TO LIN
 ENDIF 
 @ LIN , 44 SAY FH
 @ LIN , 48 SAY BH
 @ LIN , 52 SAY XMDH
 @ LIN , 60 SAY LTRIM(STR(LS))
 @ LIN , 64 SAY LTRIM(STR(DW))
 LIN = LIN + 1
ENDPROC
*------*