bcl8.prg

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

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


 SET TALK OFF
 SET CONSOLE OFF
 SET EXACT ON
 SET SAFETY OFF
 IF 1 = 0
 SET DEFAULT TO \xbbjs
 MMBZ4 = '4'
 NIAN = '1998'
 YUE = '12'
 ENDIF 
 MM = 4
 BTZ = .F.
 TUICHU = 0
 XX = 0
 BX = 0
 CL_NIAN = RIGHT(NIAN,2)
 DO WHILE .T.
 DO FORM .\src\form\bcl8
 DO CASE 
 CASE XX = 1
 DELETE File ('dat\b9*.*')
 DO PJYECL
 DELETE File ('dat\b001*.*')
 XX = 3
 CASE XX = 2
 DO XZDW
 XX = 3
 CASE XX = 3
 DO PJYEZH
 XX = 4
 CASE XX = 4
 EXIT 
 ENDCASE 
 IF BX = 1
 EXIT 
 ENDIF 
 ENDDO 
 SELECT 1
 USE 
 SELECT 2
  IF FILE("DAT\B09&cl_NIAN&YUE..DAT")
  USE  DAT\b09&cl_NIAN&YUE..DAT
 REPLACE BLX1 WITH ('3')
 REPLACE BLX2 WITH ('0')
 ENDIF 
 USE 
 SELECT 3
 USE 
 SELECT 4
 USE 
 SELECT 5
 USE 
 RETURN 

PROCEDURE PJYECL
  IF  FILE("DAT\b9&cl_NIAN&YUE.1.DAT")   
 MSGTTL = '平均余额处理'
 MESSGTXT = '本期平均余额数据已存在，覆盖?'
 IF MESSAGEBOX(MESSGTXT,36,MSGTTL) = 7
 RETURN 
 ENDIF 
 ENDIF 
 IKL = 0
 FOR HKL = IKL TO VAL(YUE) - 1
 KL = ALLTRIM(STR(HKL))
 IF LEN(KL) = 1
 KL = '0' + KL
 ENDIF 
 KLL = ALLTRIM(STR(VAL(KL) + 1))
 IF LEN(KLL) = 1
 KLL = '0' + KLL
 ENDIF 
  IF !FILE("DAT\B01&cl_NIAN&KLl..DAT")
 MSGTTL = '平均余额处理'
  Messgtxt = "&NIAN" + "年&kll.月会计报表数据文件不存在!"
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 BX = 1
 RETURN 
 ELSE 
  copy file("DAT\B01&cl_NIAN&KLl..DAT") to ("DAT\B001&cl_NIAN&KLl..DAT")
  USE DAT\B001&cl_NIAN&KLL..DAT
  INDEX ON XMDH TO DAT\B001&cl_NIAN&KLL..IDX
 USE 
  USE DAT\B001&cl_NIAN&KLL..DAT INDEX DAT\B001&cl_NIAN&KLL..IDX ALIAS b001&cl_nian&kll
 DELETE ALL FOR BLX1 <> '1'
 PACK 
 GO TOP
 MM_XMDH = 'dpbz'
 SEEK MM_XMDH
 SCAN FOR ALLTRIM(XMDH) = 'dpbz'
 TMP_DQ = DQDH
 SELECT 9
 USE .\lib\dqk.dat
 LOCATE FOR TMP_DQ = DQDH
 IF KHBZ = .T.
  sele b001&cl_nian&kll
 IF SJDW = 0
 MSGTTL = '平均余额处理'
  Messgtxt = "&NIAN" + "年&kll.月" + chr(13)+ padl(dqdh,2)  +  "地区会计报表数据文件不平!"
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 USE 
 BX = 1
 RETURN 
 ENDIF 
 ENDIF 
  sele b001&cl_nian&kll
 ENDSCAN 
 USE 
 WAIT WINDOW NOCLEAR NOWAIT '正在处理  ' + KLL + '月' + ' 地区平均余额，请稍候……'
 DO SCYE
 WAIT CLEAR
 ENDIF 
 ENDFOR 
 WAIT WINDOW '平均余额处理完毕! '
 SELECT 2
 USE 
 SELECT 3
 USE 
 SELECT 9
 USE 
ENDPROC
*------
PROCEDURE scye
 IF HKL = 0
 USE LIB\B900.DAT
  COPY stru TO DAT\b9&cl_NIAN.001.DAT
  USE DAT\b9&cl_NIAN.001.DAT
  APPE FROM DAT\B01&cl_NIAN.01.DAT for blx1='1'  
  INDEX ON XMDH TO DAT\b9&cl_NIAN.001.IDX
 USE 
 ENDIF 
  USE DAT\b9&cl_NIAN&KL.1.DAT
 REPLACE BLX1 WITH '3' , BLX2 WITH ('0')
  INDEX ON XMDH TO DAT\b9&cl_NIAN&KL.1.IDX
 USE 
  USE DAT\b9&cl_NIAN&KL.1.DAT  INDEX DAT\b9&cl_NIAN&KL.1.IDX IN 1
 SELECT 1
  COPY STRU TO  DAT\b9&cl_NIAN&KLL.1.DAT  
  USE DAT\B001&cl_NIAN&KLL..DAT  IN 2   
  USE DAT\b9&cl_NIAN&KLL.1.DAT  IN 3
 SELECT 2
 SCAN 
 SELECT 1
 LLBZ = .T.
 SEEK B.XMDH
 SCAN FOR XMDH = B.XMDH AND DQDH = B.DQDH
 SELECT 3
 APPEND BLANK
 REPLACE BLX1 WITH '3'
 REPLACE BLX2 WITH '0'
 REPLACE XMDH WITH A.XMDH
 REPLACE DQDH WITH A.DQDH
 REPLACE DA1 WITH (A.DA1 * HKL + B.DA5) / (HKL + 1)
 REPLACE DA2 WITH (A.DA2 * HKL + B.DA6) / (HKL + 1)
 LLBZ = .F.
 EXIT 
 ENDSCAN 
 IF LLBZ = .T.
 SELECT 3
 APPEND BLANK
 REPLACE BLX1 WITH '3'
 REPLACE BLX2 WITH '0'
 REPLACE XMDH WITH B.XMDH
 REPLACE DQDH WITH B.DQDH
 REPLACE DA1 WITH B.DA5 / (HKL + 1)
 REPLACE DA2 WITH B.DA6 / (HKL + 1)
 ENDIF 
 SELECT 2
 ENDSCAN 
 SELECT 1
 USE 
 SELECT 2
 USE 
 SELECT 3
 USE 
ENDPROC
*------
PROCEDURE XZDW
 XX = 1
 DO FORM .\src\form\bcl8a
 DO CASE 
 CASE XX = 1
 MM = 4
 USE IN 88 lib\xm09.dat
 SELECT 88
 REPLACE SJDW WITH 7 FOR XMDH <> ' '
 USE 
 CASE XX = 2
 MM = 2
 USE IN 88 lib\xm09.dat
 SELECT 88
 REPLACE SJDW WITH 5 FOR XMDH <> ' '
 USE 
 CASE XX = 3
 MM = 0
 USE IN 88 lib\xm09.dat
 SELECT 88
 REPLACE SJDW WITH 3 FOR XMDH <> ' '
 USE 
 ENDCASE 
ENDPROC
*------
PROCEDURE pjyezh
 DO WHILE .T.
 CAPBZ = 3
 DQ1 = 0
 DQ2 = 0
 DO FORM .\src\form\bcl1a
 IF DQ1 = 0 .OR. DQ2 = 0
 RETURN 
 ENDIF 
 IF DQ2 >= DQ1 AND DQ1 <> 0
 EXIT 
 ENDIF 
 ENDDO 
  IF !FILE("DAT\B09&cl_NIAN&YUE..DAT")
 SELECT 1
 USE LIB\b0900.DAT
  COPY stru to DAT\b09&cl_nian&YUE..DAT
 USE 
 SELECT 1
 USE 
 ENDIF 
  alter table .\dat\b09&cl_nian&yue..dat alter column da1 n(16)   
  alter table .\dat\b09&cl_nian&yue..dat alter column da2 n(16)   
 USE 
 SELECT 5
 USE LIB\DQK.DAT
 FOR I = DQ1 TO DQ2
 SELECT 5
 LOCATE FOR DQDH = I
 IF KHBZ = .F.
 MSGTTL = '提示'
 MESSGTXT = '无' + LTRIM(STR(I)) + '地区数据'
 LOOP 
 ENDIF 
 DIMENSION JS( 9 )
 CLEAR 
  IF ! file("dat\b9&cl_nian&yue.1.dat")
 MSGTTL = '平均余额生成错误'
 MESSGTXT = '处理平均余额未做或平均余额已生成，重做请先处理平均余额！！'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 
 IF BX = 1
 RETURN 
 ENDIF 
 SELECT 1
  USE DAT\b9&cl_NIAN&YUE.1.DAT
 SELECT 2
  USE DAT\b09&cl_NIAN&YUE..DAT
 SELECT 2
 DELETE FOR DQDH = I
 PACK 
 SELECT 1
 SCAN FOR DQDH = I
 SCATTER TO JS
 SELECT 2
 APPEND BLANK
 JS( 6 ) = JS(6) / 10 ** MM
 JS( 7 ) = JS(7) / 10 ** MM
 JS( 8 ) = ROUND(JS(6),0) - ROUND(JS(6),2)
 JS( 9 ) = ROUND(JS(7),0) - ROUND(JS(7),2)
 IF ALLTRIM(JS(2)) = 'dpbz'
 JS( 5 ) = 1
 ELSE 
 JS( 5 ) = MM + 3
 ENDIF 
 GATHER FROM JS
 SELECT 1
 ENDSCAN 
 SELECT 2
  INDEX ON XMDH TO DAT\b09&cl_NIAN&YUE..IDX
 SELECT 2
 USE 
  USE DAT\b09&cl_NIAN&YUE..DAT  INDEX DAT\b09&cl_NIAN&YUE..IDX IN 2
 WAIT WINDOW NOCLEAR NOWAIT '正在生成...' + PADL(I,2) + '地区平均余额 '
 DQ = DQDH
 FOR LKL = 1 TO 2
 LML = ALLTRIM(STR(LKL))
 GSXH = 0
 DO WHILE .T.
 DP = 0
 GSXH = 0
 DO DPCL
 IF DP <> 0
 DO TZKM
 IF BTZ = .T.
 EXIT 
 ENDIF 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 ENDFOR 
 SELECT 5
 SELECT 1
 USE 
 SELECT 2
 USE 
 ENDFOR 
 WAIT CLEAR
 MSGTTL = '平均余额处理'
 MESSGTXT = '平均余额表生成完毕!'
 = MESSAGEBOX(MESSGTXT,48,MSGTTL)
 SELECT 5
 USE 
 SELECT 2
 USE 
ENDPROC
*------
PROCEDURE TZKM
 SELECT 2
 FOR MKL = 1 TO CEILING(ABS(DP))
 MSGTTL = '平均余额处理'
 MESSGTXT =  ;
      PADL((XMDH),6) + '合计项与分项第' + LML + '项相差:' + CHR(13) + ALLTRIM(STR(DP)) +  ;
CHR(13) + CHR(13) + '       是否调整？'
 IF MESSAGEBOX(MESSGTXT,36,MSGTTL) = 7
 BTZ = .T.
 RETURN 
 ELSE 
 VCL = 0
 VCLM = ''
 SELECT 3
 USE LIB\dp09a.DAT
 SCAN FOR XH = GSXH
 SELECT 2
 SEEK C.XMDH
 BZLLL = 1
 SCAN FOR XMDH = C.XMDH AND DQDH = DQ
 BZLLL = 3
 IF DP > 0
  IF days&lml< vcl
  vcl= days&lml
 VCLM = XMDH
 BZLLL = 2
 EXIT 
 ENDIF 
 ELSE 
  IF days&lml >vcl
  vcl=days&lml
 VCLM = XMDH
 BZLLL = 2
 EXIT 
 ENDIF 
 ENDIF 
 ENDSCAN 
 IF BZLLL = 3
 SEEK C.XMDH
 SCAN FOR XMDH = C.XMDH AND DQDH = DQ
  vcl= days&lml
 VCLM = XMDH
 EXIT 
 ENDSCAN 
 ENDIF 
 IF BZLLL = 1
 WAIT WINDOW '本表无法调平! 任意键退出!!!'
 CLOSE DATABASES 
 RETURN TO MASTER 
 ENDIF 
 SELECT 3
 ENDSCAN 
 WAIT WINDOW NOCLEAR NOWAIT ' 调整 ' + ALLTRIM(VCLM) + '科目数据，请稍候     '
 SELECT 2
 SEEK VCLM
 SCAN FOR XMDH = VCLM AND DQDH = DQ
 IF DP > 0
  REPL days&lml WITH days&lml+1
  REPL da&lml WITH da&lml+1
 ELSE 
  REPL days&lml WITH days&lml-1
  REPL da&lml WITH da&lml-1
 ENDIF 
 EXIT 
 ENDSCAN 
 ENDIF 
 ENDFOR 
ENDPROC
*------
PROCEDURE DPCL
 SELECT 4
 USE LIB\DP09.DAT
 SCAN 
 GSXH = XH
 SUMM = 0
 SELECT 3
 USE LIB\dp09a.DAT
 SCAN FOR XH = DP09.XH
 YUSU = FH
 SELECT 2
 SEEK DP09A.XMDH
 SCAN FOR DQDH = DQ AND XMDH = DP09A.XMDH
  SUMM=SUMM&yusu.da&lml
 EXIT 
 ENDSCAN 
 SELECT 3
 ENDSCAN 
 SELECT 2
 SEEK DP09.XMDH
 SCAN FOR DQDH = DQ AND XMDH = DP09.XMDH
  DP=da&lml-SUMM     
 IF DP <> 0
 RETURN 
 ENDIF 
 EXIT 
 ENDSCAN 
 SELECT 4
 ENDSCAN 
ENDPROC
*------*