bcl6.prg

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

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


 SET TALK OFF
 SET CONSOLE OFF
 SET EXACT ON
 SET SAFETY OFF
 IF 1 = 0
 MMBZ4 = '4'
 NIAN = '1998'
 YUE = '12'
 ENDIF 
 XSLJ = ''
 XSBM = ''
 XSYK = ''
 XSLX = ''
 XSDQ = ''
 CLOSE DATABASES 
 M_BH = '  '
 M_BLX1 = '0'
 M_BLX2 = '0'
 M_DPBZ = 1
 DL = 0
 CL_NIAN = RIGHT(NIAN,2)
 DO FORM .\src\form\GONG2
 IF M_BH = '00'
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 USE IN 0 LIB\BZL.DAT
 LOCATE FOR BH = M_BH
 M_LX = LX
 M_BM = BM
 M_LS = LS
 JSBZ = .F.
 IF M_LX = .T.
 DO SZYK
 ENDIF 
 IF JSBZ = .T.
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 DQ_SZ = 0
 JSBZ = .F.
 DO FORM .\src\form\bcl6
 IF JSBZ = .T.
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 M_BLX1 = ALLTRIM(STR(M_BLX1))
 DQ_SZ = DL
 IF DQ_SZ = 0
 DQ_SZ = 3
 ENDIF 
 PD = 0
 DO HZPD
 IF PD = 0
 WAIT WINDOW NOCLEAR NOWAIT ' 正在汇总,请稍候'
 DO HZSJCL
 CLOSE DATABASES 
 USE IN 0 LIB\BLK.DAT
 SELECT BLK
 FOR LN = 1 TO M_LS
 MM_LN = 'da' + LTRIM(STR(LN))
 LOCATE FOR FIELD_NAME = MM_LN AND BH = M_BH
 IF FIELD_TYPE = 'c' .OR. FIELD_TYPE = 'C'
 M_LHY = LHY
 SET TALK OFF
 SET ESCAPE OFF
 SET SAFETY OFF
 DEFINE WINDOW QWIN FROM 0 , 0 TO 30 , 100
  USE DAT\H&M_BH&cl_NIAN..DAT IN 0
  USE LIB\XM&M_BH..DAT IN 0
  SELECT XM&M_BH
 INDEX ON XMDH TO XMTMP
  SELECT H&M_BH&cl_NIAN
  SET RELATION TO XMDH INTO XM&M_BH
 MOVE WINDOW QWIN CENTER 
 ACTIVATE WINDOW QWIN
  BROW FIELDS XM&M_BH->XMDH:H="代  号":R:W=.F., XM&M_BH->XMMC:28:H="项目名称":R:W=.F., &MM_LN.:H=" "+M_LHY+" "  FOR LEN(LTRIM(RTRIM(XM&M_BH->XMMC)))#0  AND BLX1=m_blx1 AND BLX2=m_blx2  nodelete
 RELEASE WINDOW QWIN
  SELECT XM&M_BH
 USE 
  SELECT H&M_BH&cl_NIAN
 USE 
 DELETE File XMTMP.IDX
 ENDIF 
 ENDFOR 
 WAIT WINDOW '汇总完毕'
 CLOSE DATABASES 
 ERASE FILE
 ENDIF 
 CLOSE DATABASES 
 DELETE File TMP.IDX
 DELETE File HZTMP.IDX
 RETURN 

PROCEDURE HZPD
  IF !FILE("DAT\B&M_BH&cl_NIAN&YUE..DAT")
 WAIT WINDOW '无本月数据,不能汇总'
 PD = 1
 RETURN 
 ENDIF 
 SELECT 0
  USE DAT\B&M_BH&cl_NIAN&YUE..DAT 
 INDEX ON DQDH TO DQJC FOR XMDH = 'dpbz'
 SELECT 0
 USE LIB\DQK.DAT
 N = 0
 DQ_PD = 0
 DO CASE 
 CASE DQ_SZ = 1
 SCAN FOR KHBZ = .T. AND DLBZ = .F.
 DQ_PD = 1
 M_DP = 1
 M_DQ = 1
 DO DQSJJC
 ENDSCAN 
 CASE DQ_SZ = 2
 SCAN FOR KHBZ = .T. AND DLBZ = .T.
 DQ_PD = 1
 M_DP = 1
 M_DQ = 1
 DO DQSJJC
 ENDSCAN 
 CASE DQ_SZ = 3
 SCAN FOR KHBZ = .T.
 DQ_PD = 1
 M_DP = 1
 M_DQ = 1
 DO DQSJJC
 ENDSCAN 
 ENDCASE 
  SELE B&M_BH&cl_NIAN&YUE
  USE DAT\B&M_BH&cl_NIAN&YUE..DAT 
 DELETE File DQJC.IDX
 IF DQ_PD = 0
 IF DQ_SZ = 1
 WAIT WINDOW '地区库中不存在非单列地区'
 ENDIF 
 IF DQ_SZ = 2
 WAIT WINDOW '地区库中不存在单列地区'
 ENDIF 
 IF DQ_SZ = 3
 WAIT WINDOW '  地区库为空'
 ENDIF 
 PD = 1
 RETURN 
 ENDIF 
 IF M_DP = 0 .OR. M_DQ = 1
 MSGTTL = '数据汇总'
 MESSGTXT = '是否继续汇总?'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 7
 PD = 1
 RETURN 
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE DQSJJC
  SELE B&M_BH&cl_NIAN&YUE
 SCAN FOR DQDH = DQK.DQDH AND XMDH = 'dpbz' AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 M_DQ = 0
 IF SJDW = 0
 M_DP = 0
 ENDIF 
 ENDSCAN 
 SELECT DQK
 IF N = 13
 WAIT WINDOW ''
 N = 0
 ENDIF 
 IF M_DQ = 1
 MSGTTL = '数据汇总检查'
 MESSGTXT = LTRIM(STR(DQDH)) + '地区数据不存在'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 N = N + 1
 ENDIF 
 IF M_DP = 0
 M_DPBZ = 0
 MSGTTL = '数据汇总检查'
 MESSGTXT = LTRIM(STR(DQDH)) + '地区数据不平  '
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 N = N + 1
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE HZSJCL
  IF !FILE("DAT\H&M_BH&cl_NIAN..DAT")		
  SELE B&M_BH&cl_NIAN&YUE
  COPY stru TO DAT\H&M_BH&cl_NIAN..DAT 
  USE DAT\H&M_BH&cl_NIAN..DAT IN 0
 ELSE 
  USE DAT\H&M_BH&cl_NIAN..DAT IN 0
 ENDIF 
  SELE H&M_BH&cl_NIAN
 LOCATE FOR  ;
      DQDH = VAL(YUE) AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND XMDH = 'dpbz' AND DA1 = DL
  USE LIB\XM&M_BH..DAT IN 0
 IF FOUND()
 DELETE 
 SKIP 
 DO WHILE .T.
 IF XMDH <> 'dpbz'
 DELETE 
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 EXIT 
 ENDIF 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 PACK 
 ENDIF 
 DO CASE 
 CASE DQ_SZ = 1
  SELE B&M_BH&cl_NIAN&YUE..* FROM  DAT\B&M_BH&cl_NIAN&YUE..DAT,LIB\DQK.DAT  WHERE B&M_BH&cl_NIAN&YUE..DQDH=DQK.DQDH .AND. DQK.DLBZ=.F. AND DQK.KHBZ=.T. INTO DBF FDLTMP	                 
 DATNAME = 'FDLTMP'
 CASE DQ_SZ = 2
  SELE B&M_BH&cl_NIAN&YUE..* FROM  DAT\B&M_BH&cl_NIAN&YUE..DAT,LIB\DQK.DAT WHERE B&M_BH&cl_NIAN&YUE..DQDH=DQK.DQDH  .AND. DQK.DLBZ=.T. .AND.  DQK.KHBZ=.T.  INTO DBF DLTMP		
 DATNAME = 'DLTMP'
 CASE DQ_SZ = 3
  SELE B&M_BH&cl_NIAN&YUE..* FROM  DAT\B&M_BH&cl_NIAN&YUE..DAT,LIB\DQK.DAT  WHERE B&M_BH&cl_NIAN&YUE..DQDH=DQK.DQDH  AND DQK.KHBZ=.T. INTO DBF QBTMP	                 
 DATNAME = 'QBTMP'
 ENDCASE 
 DO ZH1 WITH DATNAME , DL
 DO CASE 
 CASE DQ_SZ = 1
 SELECT FDLTMP
 USE 
 DELETE File FDLTMP.DBF
 CASE DQ_SZ = 2
 SELECT DLTMP
 USE 
 DELETE File DLTMP.DBF
 CASE DQ_SZ = 3
 SELECT QBTMP
 USE 
 DELETE File QBTMP.DBF
 ENDCASE 
ENDPROC
*------
PROCEDURE ZH1
 PARAMETER BY , DL
  SELE &BY
 INDEX ON XMDH TO TMP FOR BLX1 = M_BLX1 AND BLX2 = M_BLX2
  SELE H&M_BH&cl_NIAN
 APPEND BLANK
 REPLACE DQDH WITH VAL(YUE) , XMDH WITH 'dpbz' , SJDW WITH M_DPBZ , BLX1 WITH M_BLX1 ,  ;
      BLX2 WITH M_BLX2 , DA1 WITH DL
  SELE &BY
 TOTAL ON XMDH TO DAT
 USE IN 0 DAT
 SELECT DAT
 REPLACE DQDH WITH (VAL(YUE))
 REPLACE SJDW WITH (0)
 USE IN 0 LIB\BLK.DAT
 SELECT BLK
 FOR LN = 1 TO M_LS
 MM_LN = 'da' + LTRIM(STR(LN))
 LOCATE FOR FIELD_NAME = MM_LN AND BH = M_BH
 IF FIELD_TYPE = 'c' .OR. FIELD_TYPE = 'C'
 SELECT DAT
  REPL ALL &MM_LN WITH " "
 ENDIF 
 ENDFOR 
 SELECT BLK
 USE 
 SELECT DAT
 INDEX ON XMDH TO dat
 GO TOP
 DO .\src\prg\HZJS WITH M_BH , M_BLX1 , M_BLX2 , CL_NIAN , YUE , DL
  SELE H&M_BH&cl_NIAN
  SELE XM&M_BH
 SCAN 
  wait window "项目:"+XM&M_BH->XMDH +"汇总完毕" nowait
  SELE H&M_BH&cl_NIAN
  APPEND FROM DAT FOR XMDH=XM&M_BH->XMDH
 ENDSCAN 
 SELECT DAT
 USE 
 DELETE File DAT.DBF
 DELETE File DAT.IDX
ENDPROC
*------
PROCEDURE SZYK
 M_LXM = '   '
 M_BLX2 = '0'
 DO FORM .\src\form\BLX
 IF M_BLX2 = '0'
 JSBZ = .T.
 ENDIF 
 RETURN 
ENDPROC
*------*