shcl1w.prg

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

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



PROCEDURE SHCL1W
 PARAMETER P_BH1 , P_LX1 , P_YEA1 , P_MON1 , P_DH1 , P_DH2 , P_BH2 , P_LX3 , P_LX2
 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 , AREA
 PAT = '.\DAT\'
 DBF1 = 'B' + P_BH1 + P_YEA1 + P_MON1
 DBF2 = 'B' + P_BH2 + P_YEA1 + P_MON1
 M_SHPCL = 0
 STORE .F. TO ERR , YK1 , YK2
 STORE SPACE(12) TO BM1 , BM2
 DO ZHUNBEI
 IF ERR = .T.
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
 CLOSE DATABASES 
 CLEAR 
 RETURN 
 ENDIF 
 @ 3 , 16 SAY  ;
      SUBSTR(ALLTRIM(BM1),1,26) + ' ←─────────→ ' + SUBSTR(ALLTRIM(BM2),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 
 SELECT FZSH2
 GO TOP
 LOCATE FOR XH = MIN_XH
 IF BH <> P_BH2
 LOOP 
 ENDIF 
 STORE 8 TO LIN
 STORE 0 TO DAT1 , DAT2 , SJDW1
 STORE .T. TO FILE1_TF , FILE2_TF
 DO GET_L_FORM
 DO GET_R_FORM
 @ 8 , 10 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 FILE1_TF = .F.
 EXIT 
 ENDIF 
 ENDSCAN 
 IF FILE1_TF = .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'
 STORE 8 TO LIN
 SELECT FZSH2
 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 FILE2_TF = .F.
 EXIT 
 ENDIF 
 ENDSCAN 
 IF FILE2_TF = .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 , 14 SAY SPACE(21)
 @ 19 , 44 SAY SPACE(21)
 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 
 ? CHR(7)
 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").OR.!FILE(".\DAT\B&P_BH2&P_YEA1&P_MON1..DAT")
  messageb('.\DAT 目录下数据文件&PAT&DBF1..DAT或&PAT&DBF2..DAT不存在!',64,'提示')
 STORE .T. TO ERR
 RETURN 
 ENDIF 
 IF  .NOT. FILE('.\LIB\DQK.DAT') .OR.  .NOT. FILE('.\LIB\BZL.DAT')
  MESSAGEBOX('.\LIB 目录下DQK或BZL不存在!!',64,'提示')
 STORE .T. TO ERR
 RETURN 
 ENDIF 
 IF  .NOT. FILE('.\LIB\FZSH1.DAT') .OR.  .NOT. FILE('.\LIB\FZSH2.DAT')
  MESSAGEBOX('.\LIB 目录下数据文件FZSH1或FZSH2不存在!!',64,'提示')
 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 YK1
 STORE BM TO BM1
 LOCATE FOR BH = P_BH2
 STORE LX TO YK2
 STORE BM TO BM2
 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\&DBF1..DAT")  IN 0
 ENDIF 
 IF  .NOT. USED(DBF2)
  USE (".\DAT\&DBF2..DAT")  IN 0 
 ENDIF 
ENDPROC
*------
PROCEDURE L_COMPUT
 SELECT FZSH1
 L_DBLS = 0
 L_DBLS = 5 + LS
  SELE B&P_BH1&P_YEA1&P_MON1
 IF YK1 = .T.
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = AREA AND BLX1 = P_LX1 AND BLX2 = P_LX2
 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)) + '地区' + P_BH1 + '表不存在!'
 STORE .F. TO FILE1_TF
 RETURN 
 ENDIF 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = AREA AND BLX1 = P_LX1
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW NOWAIT LTRIM(STR(AREA)) + '地区' + P_BH1 + '表不存在!'
 STORE .F. TO FILE1_TF
 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
 SELECT FZSH2
 R_DBLS = 0
 R_DBLS = LS + 5
  SELE B&P_BH2&P_YEA1&P_MON1
 IF YK2 = .T.
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = AREA AND BLX1 = P_LX3 AND BLX2 = P_LX2
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = AREA AND BLX2 = '1'
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW '主表:' + P_BH2 + '表 ' + LTRIM(STR(AREA)) + '地区不存在!!'
 STORE .F. TO FILE2_TF
 RETURN 
 ENDIF 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = AREA AND BLX1 = P_LX3
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = AREA
 IF  .NOT. FOUND()
 ? CHR(7)
 WAIT WINDOW P_BH2 + '表 ' + LTRIM(STR(AREA)) + '地区不存在!!'
 STORE .F. TO FILE2_TF
 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 , 8 SAY '┌──┬─┬───┬─┬─┐'
 @ 5 , 8 SAY '│序  │符│项  目│栏│单│'
 @ 6 , 8 SAY '│  号│号│代  号│数│位│'
 @ 7 , 8 SAY '├──┼─┼───┼─┼─┤'
 @ 8 , 8 SAY '│    │  │      │  │  │'
 @ 9 , 8 SAY '│    │  │      │  │  │'
 @ 10 , 8 SAY '│    │  │      │  │  │'
 @ 11 , 8 SAY '│    │  │      │  │  │'
 @ 12 , 8 SAY '│    │  │      │  │  │'
 @ 13 , 8 SAY '│    │  │      │  │  │'
 @ 14 , 8 SAY '│    │  │      │  │  │'
 @ 15 , 8 SAY '│    │  │      │  │  │'
 @ 16 , 8 SAY '│    │  │      │  │  │'
 @ 17 , 8 SAY '│    │  │      │  │  │'
 @ 18 , 8 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 , 16 SAY FH
 @ 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 XMDH
 @ LIN , 56 SAY LTRIM(STR(LS))
 @ LIN , 60 SAY LTRIM(STR(DW))
 LIN = LIN + 1
ENDPROC
*------*