hzshw.prg

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

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



PROCEDURE HZSHw
 PARAMETER H_BH1 , H_LX1 , H_YEA , H_MON , H_BH2 , OP
 CLEAR 
 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 32 , 120 FONT '宋体' , 12 COLOR SCHEME 3 FLOAT TITLE  ;
      ' 审核数据' IN SCREEN DOUBLE
 MOVE WINDOW WINM CENTER 
 ACTIVATE WINDOW WINM
 STORE .F. TO YK1 , YK2
 STORE '' TO BM1 , BM2
 DO ZHUNBEI
 STORE 8 TO LIN
 SELECT FZSH1
 MAX_XH = RECCOUNT()
 DO CASE 
 CASE OP = 1
 @ 3 , 30 - LEN(ALLTRIM(BM1)) SAY  ;
      SUBSTR(ALLTRIM(BM1),1,26) + ' ←────→ ' + SUBSTR(ALLTRIM(BM2),1,26)
 CASE OP = 2
 @ 3 , 30 - LEN(ALLTRIM(BM1)) SAY SUBSTR(ALLTRIM(BM1),1,26)
 ENDCASE 
 FOR MIN_XH = 1 TO MAX_XH
 SELECT FZSH1
 GO TOP
 LOCATE FOR XH = MIN_XH
 IF BH = '10'
 LOOP 
 ENDIF 
 DO CASE 
 CASE OP = 1
 SELECT FZSH1
 GO TOP
 LOCATE FOR XH = MIN_XH
 IF BH <> H_BH1
 LOOP 
 ENDIF 
 SELECT FZSH2
 GO TOP
 LOCATE FOR XH = MIN_XH
 IF BH <> H_BH2
 LOOP 
 ENDIF 
 CASE OP = 2
 SELECT FZSH1
 GO TOP
 LOCATE FOR XH = MIN_XH
 IF BH <> H_BH1
 LOOP 
 ENDIF 
 ENDCASE 
 STORE 0 TO DAT1 , DAT2 , SJDW1
 STORE 8 TO LIN
 STORE .T. TO FILE_TF
 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 FILE_TF = .F.
 EXIT 
 ENDIF 
 ENDSCAN 
 IF FILE_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'
 SELECT FZSH2
 LIN = 8
 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 FILE_TF = .F.
 EXIT 
 ENDIF 
 ENDSCAN 
 IF FILE_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 DAT1 <> DAT2
 ? 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 
 WAIT WINDOW '核对完毕！'
 CLOSE DATABASES 
 CLEAR 
 DEACTIVATE WINDOW WINM
 RELEASE WINDOW WINM
ENDPROC
*------
PROCEDURE ZHUNBEI
 IF  .NOT. USED('BZL')
 USE IN 0 .\LIB\BZL.DAT
 ENDIF 
 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('BZL')
 USE IN 0 ('.\LIB\BZL.dat')
 ENDIF 
 SELECT BZL
 GO TOP
 LOCATE FOR BH = H_BH1
 STORE BM TO BM1
 LOCATE FOR BH = H_BH2
 STORE BM TO BM2
ENDPROC
*------
PROCEDURE L_COMPUT
 STORE BH TO BH1
 L_DBLS = 0
 L_DBLS = LS + 5
  IF !FILE(".\DAT\H&BH1&H_YEA..DAT")
 ? CHR(7)
  WAIT "需审核的汇总文件.\DAT\H&BH1&H_YEA..DAT不存在!" WINDOW NOWAIT
 STORE .F. TO FILE_TF
 RETURN 
 ENDIF 
  IF !USED("H&BH1&H_YEA.")
  use ".\DAT\H&BH1&H_YEA..DAT" IN 0
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = BH1
 STORE LX TO YK1
  SELE H&BH1&H_YEA
 GO TOP
 IF YK1 = .T.
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = VAL(H_MON) AND BLX1 = H_LX1 AND BLX2 = '1'
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = VAL(H_MON) AND BLX2 = '1'
 IF  .NOT. FOUND()
 ? CHR(7)
  WAIT "&BH1 表 &H_MON 月 汇总数据不存在!" WINDOW NOWAIT
 STORE .F. TO FILE_TF
 RETURN 
 ENDIF 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = VAL(H_MON) AND BLX1 = H_LX1
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH1.XMDH AND DQDH = VAL(H_MON)
 IF  .NOT. FOUND()
 ? CHR(7)
  WAIT "&BH1 表 &H_MON 月 汇总数据不存在!" WINDOW NOWAIT
 STORE .F. TO FILE_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
 STORE BH TO BH2
 R_DBLS = 0
 R_DBLS = LS + 5
  IF !FILE(".\DAT\H&BH2&H_YEA..DAT")
 ? CHR(7)
  WAIT "依据:汇总文件H&BH2&H_YEA..DAT不存在!" WINDOW
 STORE .F. TO FILE_TF
 RETURN 
 ENDIF 
  IF !USED("H&BH2&H_YEA.")
  use ".\DAT\H&BH2&H_YEA..DAT" IN 0
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = BH2
 STORE LX TO YK2
  SELE H&bh2&H_YEA
 GO TOP
 IF YK2 = .T.
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = VAL(H_MON) AND BLX1 = H_LX1 AND BLX2 = '1'
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = VAL(H_MON) AND BLX2 = '1'
 IF  .NOT. FOUND()
 ? CHR(7)
  WAIT "依据:&BH2 表 H_MON 月 汇总数据不存在!" WINDOW NOWAIT
 STORE .F. TO FILE_TF
 RETURN 
 ENDIF 
 ENDIF 
 ELSE 
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = VAL(H_MON) AND BLX1 = H_LX1
 IF  .NOT. FOUND()
 LOCATE FOR XMDH = FZSH2.XMDH AND DQDH = VAL(H_MON)
 IF  .NOT. FOUND()
 ? CHR(7)
  WAIT "依据:&BH2 表 H_MON 月 汇总数据不存在!" WINDOW NOWAIT
 STORE .F. TO FILE_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 , 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 '└──┴─┴─┴───┴─┴─┘'
 @ 19 , 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 '    └─┴─┴───┴─┴─┘'
 @ 19 , 38 SAY '合计 ='
ENDPROC
*------
PROCEDURE CHA_GET1
 SELECT FZSH1
 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
 SELECT FZSH2
 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
*------*