shcl3w.prg

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

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



PROCEDURE SHCL3w
 PARAMETER M_Y1 , M_M1 , M_DH1 , M_DH2 , M_LX1
 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
 STORE 0 TO L_DBLS , R_DBLS , LIN , COL , AREA
 STORE '  ' TO BH1 , BH2
 M_SHPCL = 0
 CLEAR 
 DO OPEN_FILE
 CLEAR 
 FOR AREA = VAL(M_DH1) TO VAL(M_DH2)
 @ 2 , 18 SAY '正在审核      地区'
 @ 2 , 28 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
 STORE 0 TO DAT1 , DAT2 , SJDW1
 STORE .T. TO PROC_ERR
 STORE 8 TO LIN
 DO GET_L_FORM
 DO GET_R_FORM
 @ 8 , 6 SAY LTRIM(STR(MIN_XH))
 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)
 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 '全部核对完毕！'
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
ENDPROC
*------
PROCEDURE L_COMPUT
 STORE BH TO BH1
 IF BH1 = '10'
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 L_DBLS = 0
 L_DBLS = LS + 5
 PAT = '.\DAT\'
 DBF1 = 'b' + BH1 + M_Y1 + M_M1
  IF !FILE(".\DAT\B&BH1&M_Y1&M_M1..DAT")
 ? CHR(7)
  WAIT ".\DAT\B&BH1&M_Y1&M_M1..DAT不存在!!" WINDOW NOWAIT
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 IF  .NOT. USED(DBF1)
  use &PAT&DBF1..DAT  IN 0
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = BH1
 STORE LX TO YK1
  SELE b&bh1&m_y1&m_m1
 GO TOP
 IF YK1 = .T.
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = AREA AND BLX1 = M_LX1 AND BLX2 = '1'
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = AREA AND BLX2 = '1'
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW NOWAIT LTRIM(STR(AREA)) + '地区' + BH1 + '表数据不存在!'
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = AREA AND BLX1 = M_LX1
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW NOWAIT LTRIM(STR(AREA)) + '地区' + BH1 + '表数据不存在!'
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 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
 STORE BH TO BH2
 R_DBLS = 0
 R_DBLS = LS + 5
 PAT = '.\DAT\'
 DBF2 = 'B' + BH2 + M_Y1 + M_M1
  IF !FILE(".\DAT\B&BH2&M_Y1&M_M1..DAT")
 ? CHR(7)
  WAIT ".\DAT\B&BH2&M_Y1&M_M1..DAT文件不存在!!" WINDOW NOWAIT
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 IF  .NOT. USED(DBF2)
  use .\DAT\B&BH2&M_Y1&M_M1..DAT IN 0
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = BH2
 STORE LX TO YK2
  SELE B&BH2&M_Y1&M_M1
 GO TOP
 IF YK2 = .T.
 LOCATE FOR XMDH = FZSH2.XMDH AND BLX1 = M_LX1 AND BLX2 = '1' AND DQDH = AREA
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND BLX2 = '1' AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW NOWAIT LTRIM(STR(AREA)) + '地区' + BH2 + '表数据不存在!'
 STORE .F. TO PROC_ERR
 RETURN 
 ENDIF 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH2.XMDH AND BLX1 = M_LX1 AND DQDH = AREA
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW NOWAIT LTRIM(STR(AREA)) + '地区' + BH2 + '表数据不存在!'
 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 OPEN_FILE
 IF  .NOT. USED('BZL')
 USE IN 0 ('.\LIB\bzl.DAT')
 ENDIF 
 IF  .NOT. USED('DQK')
 USE IN 0 ('.\LIB\DQK.DAT')
 ENDIF 
 IF  .NOT. USED('FZSH1')
 USE IN 0 ('.\LIB\FZSH1.DAT')
 ENDIF 
 IF  .NOT. USED('FZSH2')
 USE IN 0 ('.\LIB\FZSH2.DAT')
 ENDIF 
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 BH
 @ LIN , 20 SAY XMDH
 @ LIN , 28 SAY LTRIM(STR(LS))
 @ LIN , 32 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
*------*