bbdy1.prg

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

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


 YSYML = '.'
 XSYML = '.'
 M_BLX1 = 0
 B_LX2 = '0'
 DYXZ_WEI = 'yl'
 DYJM = 'PRN       '
 XNIAN = RIGHT(NIAN,2)
 SET TALK OFF
 SET SAFETY OFF
  USE &ysyml.\LIB\DYZK.DAT 
 LOCATE FOR DYBZ = .T.
 M_DYJH = DYJH
 USE 
  REST FROM &ysyml.\BTT.MEM ADDI
 BBXZ = '   '
 I = 1
 DIMENSION BTM( 10 ) , ZJM( 10 ) , ZWM( 10 ) , HJM( 10 ) , CS( 5 )
 DIMENSION ARRAY_REP( 20 )
 STORE 1 TO ZJMKZ , ZWMKZ , HJMKZ , CSHKZ
  SET DEFA TO &xsyml
  USE &ysyml.\LIB\BZL.DAT
 M_BH = '00'
  DO FORM &xsyml.\src\form\gong2   
 SS = M_BH
 IF M_BH = '00'
 RETURN 
 ENDIF 
 IF M_BH = '99'
  DO &xsyml.\src\prg\DY99   
 CLOSE DATABASES 
 ELSE 
  USE &ysyml.\LIB\BZL.DAT
 LOCATE FOR BH = SS
 M_BM = LTRIM(TRIM(SUBSTR(BM,3,20)))
 USE 
 BBXZ3 = ''
 BBXZ2 = ''
  DO FORM &xsyml.\SRC\FORM\BBDY  
 IF BBXZ3 = '退出'
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 DO KDYBB
 ENDIF 
 CLOSE DATABASES 
  DELE FILE &ysyml.\dat\dyls.DBF
  DELE FILE &ysyml.\dat\dy_data.dat
  DELE FILE &ysyml.\dat\dy_fata.dat
 RETURN 

PROCEDURE KDYBB
 PRIVATE DY_HJJ , DY_ZJJ , CISHU , H_DY , WEZH , PRIV
 Z_DY = 0
 SELECT 3
  USE &ysyml.\lib\bt2.dat
 COUNT FOR BH = SS TO JDS
 IF JDS = 0
 = MESSAGEBOX('表体没有设置!',0,'提示信息')
 RETURN 
 ENDIF 
 DIMENSION DYDD( JDS , 5 )
 PRIVATE DYDD
 DO BB
 STORE '' TO DY_HJJ , DY_ZJJ
 STORE 0 TO CISHU , H_DY , WEZH
 PRIVATE DY_S , DY_G
 STORE 1 TO DY_S , DY_S1 , DY_S2
 DY_G = .F.
  RESTORE FROM &ysyml.\DYJ.MEM ADDI
 DO CSXZ
  RESTORE FROM &ysyml.\qq.mem ADDI
 HZH = QQ
 BBXZ1 = ''
 DQXZ = -1
  DO FORM &xsyml\SRC\FORM\DQXZA  
 IF DQXZ < 4
  IF !FILE("DAT\H&SS&xNIAN..DAT")
 = MESSAGEBOX('汇总数据文件不存在!',64,'提示信息')
 RETURN 
 ENDIF 
 ENDIF 
 SELECT 9
  USE &ysyml.\lib\xm&ss..dat
 JLS2 = RECCOUNT()
 DW = ''
 DO CASE 
 CASE SJDW = 3
 DW = '单位:元'
 CASE SJDW = 5
 DW = '单位:百元'
 CASE SJDW = 6
 DW = '单位:千元'
 CASE SJDW = 7
 DW = '单位:万元'
 ENDCASE 
 DO CASE 
 CASE DQXZ = 1
 DO DQXZ1
 CASE DQXZ = 2
 SELECT 4
  USE &ysyml.\DAT\H&SS&XNIAN..DAT
 IF BBXZ2 == ''
  LOCA FOR DQDH=&YUE .AND. DA1=1 .AND. XMDH="dpbz" 
 ELSE 
  LOCA FOR DQDH=&YUE .AND. DA1=1 .AND. XMDH="dpbz" .and. blx2=b_lx2
 ENDIF 
 IF EOF()
 = MESSAGEBOX('汇总数据不存在!',0,'提示信息')
 RETURN 
 ELSE 
 BBXZ1 = '单 列 汇 总 '
 BBBZ = SJDW
 JLS1 = RECNO()
  COPY TO &ysyml.\DAT\dyls FOR RECN()>jLs1 .and. RECN()<=jLs2+JLS1
 DO DYCZ
 ENDIF 
 CASE DQXZ = 3
 SELECT 4
  USE &ysyml.\DAT\H&SS&XNIAN..DAT
 IF BBXZ2 == ''
  LOCA FOR DQDH=&YUE .AND. DA1=2 .and. XMDH="dpbz" 
 ELSE 
  LOCA FOR DQDH=&YUE .AND. DA1=2 .and. XMDH="dpbz" .and. blx2=b_lx2
 ENDIF 
 IF EOF()
 = MESSAGEBOX('汇总数据不存在!',0,'提示信息')
 RETURN 
 ELSE 
 BBXZ1 = '非 单 列 汇 总 '
 BBBZ = SJDW
 JLS1 = RECNO()
  COPY TO &ysyml.\DAT\dyls FOR RECN()>jLs1 .and. RECN()<=jLs2+JLS1
  DO FORM &xsyml.\src\form\xzys   
 DO DYCZ
 ENDIF 
 CASE DQXZ = 4
 STORE 0 TO DQ1 , DQ2
  DO FORM &xsyml.\src\form\xzdydq  
 IF DQ1 = 0 AND DQ2 = 0
 RETURN 
 ELSE 
  DO FORM &xsyml.\src\form\xzys  
 IF ALLTRIM(DYJM) == 'PRN' .OR. ALLTRIM(DYJM) == 'prn'
 DY_RDY = 'Y'
 IF  .NOT. PRINTSTATUS()
 DO FORM src\form\DYJCS
 ENDIF 
 IF DY_RDY = 'n' .OR. DY_RDY = 'N'
 RETURN 
 ENDIF 
 ENDIF 
 SELECT 2
  USE &ysyml.\lib\DQK.dat
 FOR I_YXL = DQ1 TO DQ2
 SELECT 2
 LOCATE FOR DQDH = I_YXL
 IF EOF()
 LOOP 
 ELSE 
 HZH = DQMC
 SELECT 4
  USE &ysyml.\DAT\B&SS&XNIAN&YUE..DAT
 IF BBXZ2 == ''
 LOCATE FOR DQDH = I_YXL AND VAL(BLX1) = M_BLX1 AND XMDH = 'dpbz'
 ELSE 
 LOCATE FOR DQDH = I_YXL AND VAL(BLX1) = M_BLX1 AND VAL(BLX2) = M_BLX2 AND XMDH = 'dpbz'
 ENDIF 
 IF EOF()
 CLEAR 
 = MESSAGEBOX(STR(I_YXL) + '地区数据不存在!',0,'提示信息')
 LOOP 
 ENDIF 
 BBBZ = SJDW
 JLS1 = RECNO()
  COPY TO &ysyml.\DAT\dyls FOR RECN()>jLs1 .and. RECN()<=jLS2+JLS1
 DO DYCZ
 ENDIF 
 ENDFOR 
 ENDIF 
 CASE DQXZ = 5
 SELNO = .F.
 DD = 'A'
 FF = '00'
 DO FORM src\form\dysbb
 IF SELNO = .T.
 RETURN 
 ENDIF 
 SELECT 4
  USE &dd:s&xnian&ff&ss..DAT
 IF BBXZ2 == ''
  LOCA FOR DQDH=&YUE  .and. XMDH="dpbz" 
 ELSE 
  LOCA FOR DQDH=&YUE  .and. XMDH="dpbz" .and. blx2=b_lx2
 ENDIF 
 IF EOF()
 WAIT WINDOW '上报数据不存在! '
 = INKEY(2)
 RETURN 
 ELSE 
 BBXZ1 = '上 报 '
 BBBZ = SJDW
 JLS1 = RECNO()
 COPY TO DAT\dyls FOR RECNO() > JLS1 AND RECNO() <= JLS2 + JLS1
  DO FORM &xsyml.\src\form\xzys  
 DO DYCZ
 ENDIF 
 CASE DQXZ = 6
 RETURN 
 ENDCASE 
ENDPROC
*------
PROCEDURE DYCZ
 STORE 1 TO I , ZJMKZ , ZWMKZ , HJMKZ , CSHKZ
 STORE '' TO BTM( 1 ) , ZJM( 1 ) , ZWM( 1 ) , HJM( 1 ) , CS( 1 )
 DO S_DY
 DO DY_YXL
 USE 
 IF DYXZ_WEI = 'yl'
  REPORT FORM src\rpt\zbdy&m_bh PREVIEW   
 ELSE 
  REPORT FORM src\rpt\zbdy&m_bh NOCONSOLE to printer prompt
 ENDIF 
 WAIT CLEAR
 RETURN 
ENDPROC
*------
PROCEDURE CSXZ
 SELECT 11
  USE &ysyml.\lib\BT1.dat
 LOCATE FOR BH = SS
 WEZH = WZ
 SELECT 3
 CHANG = ''
  USE &ysyml.\lib\bt2.dat
 SCAN FOR BH = SS
 CHANG = CHANG + ZDMC
 ENDSCAN 
 CISHU = OCCURS('xmmc',CHANG)
 SELECT 12
  USE &ysyml.\lib\dyFY.dat  
 LOCATE FOR BH = SS
 IF FOUND()
 DY_S = FY
 DY_G = GX
 ENDIF 
 USE 
 IF BBXZ3 = '试算表'
 DY_S = 7
 ENDIF 
 REC = 0
 REC1 = 0
 SELECT 9
 IF CISHU = 0
 = MESSAGEBOX('表体库设置有误,不能找到项目名称',0,'提示信息')
 RETURN 
 ENDIF 
  USE &ysyml.\lib\xm&ss..dat
 COUNT FOR LEFT(ALLTRIM(XMDH),1) <> 'B' AND LEFT(ALLTRIM(XMDH),1) <> 'b' TO REC
 COUNT FOR LEFT(ALLTRIM(XMDH),1) = 'B' .OR. LEFT(ALLTRIM(XMDH),1) = 'b' TO REC1
 IF REC1 > 0
 SELECT 3
 CHANG = ''
  USE &ysyml.\lib\bbt2.dat
 SCAN FOR BH = SS
 CHANG = CHANG + ZDMC
 ENDSCAN 
 CISHU1 = OCCURS('xmmc',CHANG)
 H_DY2 = INT(REC1 / CISHU1)
 IF H_DY2 < REC1 / CISHU1
 H_DY2 = H_DY2 + 1
 ENDIF 
 ELSE 
 H_DY2 = 0
 ENDIF 
 H_DY1 = REC / CISHU
 H_DY = INT(H_DY1 / DY_S)
 IF H_DY1 / DY_S > H_DY
 IF SS = '98'
 H_DY = 32
 ELSE 
 H_DY = H_DY + 1
 ENDIF 
 ENDIF 
 IF SS = '09'
 H_DY = 31
 ELSE 
 ENDIF 
 IF SS = '21'
 H_DY = H_DY + 1
 ELSE 
 ENDIF 
 H_BDY = H_DY + H_DY2
 SELECT 6
  USE &ysyml.\lib\DYJ.dat
 LOCATE FOR DYJH = M_DYJH AND BH = M_BH
 BTMM = ALLTRIM(BTM)
 DO WHILE AT(';',BTMM) <> 0
 L = AT(';',BTMM)
 BTM( I ) = LEFT(BTMM,L - 1)
 BTMM = RIGHT(BTMM,LEN(BTMM) - L)
 I = I + 1
 ENDDO 
 BTM( I ) = BTMM
 ZWMM = ALLTRIM(ZWM)
 DO WHILE AT(';',ZWMM) <> 0
 L = AT(';',ZWMM)
 ZWM( ZWMKZ ) = LEFT(ZWMM,L - 1)
 ZWMM = RIGHT(ZWMM,LEN(ZWMM) - L)
 ZWMKZ = ZWMKZ + 1
 ENDDO 
 ZWM( ZWMKZ ) = ZWMM
 CSMM = ALLTRIM(CSH)
 DO WHILE AT(';',CSMM) <> 0
 L = AT(';',CSMM)
 CS( CSHKZ ) = LEFT(CSMM,L - 1)
 CSMM = RIGHT(CSMM,LEN(CSMM) - L)
 CSHKZ = CSHKZ + 1
 ENDDO 
 CS( I ) = CSMM
 DY_HJJ = ALLTRIM(HJM)
 HJM( HJMKZ ) = DY_HJJ
 SELECT 7
  USE &ysyml.\lib\B&SS..dat
 Z_DY = LEN(ALLTRIM(P))
 SELECT 6
 DY_ZJJ = ALLTRIM(ZJM)
 ZJM( ZJMKZ ) = DY_ZJJ
ENDPROC
*------
PROCEDURE dy_yxl
 DO CASE 
 CASE M_BH = '01'
 CREATE TABLE rep_table FREE ( XMDH C ( 6 ) , XMMC C ( 50 ) , SNJS N ( 15 , 2 ) , SNDS N  ;
      ( 15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2  ;
      ) , BNDYE N ( 15 , 2 ) )
 CASE M_BH = '02'
 CREATE TABLE rep_table FREE ( HH1 C ( 5 ) , XM1 C ( 40 ) , SND1 N ( 15 , 2 ) , BNJS1 N  ;
      ( 15 , 2 ) , HH2 C ( 4 ) , XM2 C ( 40 ) , SND2 N ( 15 , 2 ) , BNJS2 N  ;
      ( 15 , 2 ) , HH3 C ( 4 ) , XM3 C ( 40 ) , SND3 N ( 15 , 2 ) , BNJS3 N  ;
      ( 15 , 2 ) )
 CASE M_BH = '03'
 CREATE TABLE rep_table FREE ( ZC1 C ( 50 ) , HC1 C ( 3 ) , NCS1 N ( 15 , 2 ) , QMS1 N (  ;
      15 , 2 ) , ZC2 C ( 50 ) , HC2 C ( 3 ) , NCS2 N ( 15 , 2 ) , QMS2 N (  ;
      15 , 2 ) )
 CASE M_BH = '04'
 CREATE TABLE rep_table FREE ( XM1 C ( 50 ) , HH1 C ( 3 ) , PJYE1 N ( 15 , 2 ) , SSLX1 N  ;
      ( 15 , 2 ) , SXL1 N ( 6 , 2 ) , BZ1 N ( 6 , 2 ) , ZXLL1 N ( 6 , 2 ) ,  ;
      YSLX1 N ( 15 , 2 ) , XM2 C ( 50 ) , HH2 C ( 3 ) , PJYE2 N ( 15 , 2 ) ,  ;
      SSLX2 N ( 15 , 2 ) , SXL2 N ( 6 , 2 ) , BZ2 N ( 6 , 2 ) , ZXLL2 N (  ;
      6 , 2 ) , YSLX2 N ( 15 , 2 ) )
 CASE M_BH = '05'
 CREATE TABLE rep_table FREE ( XM1 C ( 40 ) , XH1 C ( 3 ) , JE1 N ( 15 , 2 ) , XM2 C (  ;
      40 ) , XH2 C ( 3 ) , SL2 N ( 15 , 2 ) , JE2 N ( 15 , 2 ) , XM3 C ( 40 ) ,  ;
      XH3 C ( 3 ) , SL3 N ( 15 , 2 ) , JE3 N ( 15 , 2 ) )
 CASE M_BH = '06'
 CREATE TABLE rep_table FREE ( XM C ( 40 ) , HC C ( 3 ) , BNSJ N ( 15 , 2 ) , SNSJ N (  ;
      15 , 2 ) , SM C ( 70 ) )
 CASE M_BH = '07'
 CREATE TABLE rep_table FREE ( XM C ( 50 ) , HH C ( 3 ) , SNJS N ( 15 , 2 ) , SNDS N (  ;
      15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2 ) ,  ;
      BNDYE N ( 15 , 2 ) )
 CASE M_BH = '08'
 CREATE TABLE rep_table FREE ( XM1 C ( 50 ) , HC1 C ( 3 ) , SZ1 N ( 15 , 2 ) , XM2 C (  ;
      50 ) , HC2 C ( 3 ) , SZ2 N ( 15 , 2 ) , XM3 C ( 50 ) , HC3 C ( 3 ) ,  ;
      SZ3 N ( 15 , 2 ) )
 CASE M_BH = '09'
 CREATE TABLE rep_table FREE ( DH1 C ( 6 ) , XM1 C ( 50 ) , FS1 N ( 15 , 2 ) , DS1 N (  ;
      15 , 2 ) , DH2 C ( 6 ) , XM2 C ( 50 ) , FS2 N ( 15 , 2 ) , DS2 N ( 15 ,  ;
      2 ) , DH3 C ( 6 ) , XM3 C ( 50 ) , FS3 N ( 15 , 2 ) , DS3 N ( 15 , 2  ;
      ) )
 CASE M_BH = '19'
 CREATE TABLE rep_table FREE ( XMDH C ( 6 ) , XMMC C ( 50 ) , SNJS N ( 15 , 2 ) , SNDS N  ;
      ( 15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2  ;
      ) , BNDYE N ( 15 , 2 ) )
 CASE M_BH = '20'
 CREATE TABLE rep_table FREE ( XM C ( 50 ) , HH C ( 3 ) , SNJS N ( 15 , 2 ) , SNDS N (  ;
      15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2 ) ,  ;
      BNDYE N ( 15 , 2 ) )
 CASE M_BH = '21'
 CREATE TABLE rep_table FREE ( XM1 C ( 40 ) , XH1 C ( 3 ) , JE1 N ( 15 , 2 ) , XM2 C (  ;
      40 ) , XH2 C ( 3 ) , SL2 N ( 15 , 2 ) , JE2 N ( 15 , 2 ) , XM3 C ( 40 ) ,  ;
      XH3 C ( 3 ) , SL3 N ( 15 , 2 ) , JE3 N ( 15 , 2 ) )
 CASE M_BH = '23'
 CREATE TABLE rep_table FREE ( XM1 C ( 50 ) , HC1 C ( 3 ) , SZ1 N ( 15 , 2 ) , XM2 C (  ;
      50 ) , HC2 C ( 3 ) , SZ2 N ( 15 , 2 ) , XM3 C ( 50 ) , HC3 C ( 3 ) ,  ;
      SZ3 N ( 15 , 2 ) )
 CASE M_BH = '24'
 CREATE TABLE rep_table FREE ( XM C ( 50 ) , HH C ( 3 ) , SNJS N ( 15 , 2 ) , SNDS N (  ;
      15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2 ) ,  ;
      BNDYE N ( 15 , 2 ) )
 CASE M_BH = '25'
 CREATE TABLE rep_table FREE ( XM C ( 50 ) , HH C ( 3 ) , SNJS N ( 15 , 2 ) , SNDS N (  ;
      15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2 ) ,  ;
      BNDYE N ( 15 , 2 ) )
 CASE M_BH = '26'
 CREATE TABLE rep_table FREE ( XMDH C ( 6 ) , XMMC C ( 50 ) , SNJS N ( 15 , 2 ) , SNDS N  ;
      ( 15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2  ;
      ) , BNDYE N ( 15 , 2 ) )
 CASE M_BH = '27'
 CREATE TABLE rep_table FREE ( HH1 C ( 5 ) , XM1 C ( 40 ) , SND1 N ( 15 , 2 ) , BNJS1 N  ;
      ( 15 , 2 ) , HH2 C ( 4 ) , XM2 C ( 40 ) , SND2 N ( 15 , 2 ) , BNJS2 N  ;
      ( 15 , 2 ) , HH3 C ( 4 ) , XM3 C ( 40 ) , SND3 N ( 15 , 2 ) , BNJS3 N  ;
      ( 15 , 2 ) )
 CASE M_BH = '28'
 CREATE TABLE rep_table FREE ( XMDH C ( 6 ) , XMMC C ( 50 ) , SNJS N ( 15 , 2 ) , SNDS N  ;
      ( 15 , 2 ) , BNJS N ( 15 , 2 ) , BNDS N ( 15 , 2 ) , BNJYE N ( 15 , 2  ;
      ) , BNDYE N ( 15 , 2 ) )
 CASE M_BH = '29'
 CREATE TABLE rep_table FREE ( ZC1 C ( 50 ) , HC1 C ( 3 ) , NCS1 N ( 15 , 2 ) , QMS1 N (  ;
      15 , 2 ) , ZC2 C ( 50 ) , HC2 C ( 3 ) , NCS2 N ( 15 , 2 ) , QMS2 N (  ;
      15 , 2 ) )
 CASE M_BH = '30'
 CREATE TABLE rep_table FREE ( HH1 C ( 5 ) , XM1 C ( 40 ) , SND1 N ( 15 , 2 ) , BNJS1 N  ;
      ( 15 , 2 ) , HH2 C ( 4 ) , XM2 C ( 40 ) , SND2 N ( 15 , 2 ) , BNJS2 N  ;
      ( 15 , 2 ) , HH3 C ( 4 ) , XM3 C ( 40 ) , SND3 N ( 15 , 2 ) , BNJS3 N  ;
      ( 15 , 2 ) )
 CASE M_BH = '98'
 CREATE TABLE rep_table FREE ( DH1 C ( 6 ) , XM1 C ( 50 ) , FS1 N ( 15 , 2 ) , DS1 N (  ;
      15 , 2 ) , DH2 C ( 6 ) , XM2 C ( 50 ) , FS2 N ( 15 , 2 ) , DS2 N ( 15 ,  ;
      2 ) )
 CASE M_BH = '99'
 CREATE TABLE rep_table FREE ( DH1 C ( 6 ) , XM1 C ( 50 ) , FS1 N ( 15 , 2 ) , DS1 N (  ;
      15 , 2 ) , DH2 C ( 6 ) , XM2 C ( 50 ) , FS2 N ( 15 , 2 ) , DS2 N ( 15 ,  ;
      2 ) )
 ENDCASE 
 SELECT 4
  USE &ysyml.\DAT\dy_data.DAT
 BTTM = ALLTRIM(BTT) + ALLTRIM(M_BM)
 PP_BT = BTTM
 MM_BT = ''
 DO WHILE  .NOT. EMPTY(PP_BT)
 MM_BT = MM_BT + LEFTC(LTRIM(PP_BT),1) + ' '
 PP_BT = SUBSTRC(LTRIM(PP_BT),2)
 ENDDO 
 SELECT 4
 DWMC = ' 单位名称: ' + HZH
 TMP_RP = ''
 IF M_BH = '98'
 M_NIAN = NIAN
 KK_NIAN = NIAN
 IF YUE = '12'
 M_NAIN = RIGHT(ALLTRIM(STR(VAL(NIAN) + 1)),2)
 KK_NIAN = ALLTRIM(STR(VAL(NIAN) + 1))
 ENDIF 
 TMP_RQ = KK_NIAN + ' 年 元 月 1 日 '
 ELSE 
 TMP_RQ = NIAN + ' 年 ' + YUE + ' 月'
 ENDIF 
 TMP_DYYS = 0
 TMP_YS = ''
 IF DY_S > 1
 TMP_DYYS = DY_S
 TMP_YS = '共 ' + ALLTRIM(STR(DY_S)) + ' 页  '
 ENDIF