bbdy1.prg

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

 TMP_BH = ''
 IF YUE == '12'
 DO CASE 
 CASE M_BH = '01'
 TMP_BH = '(表一    )'
 CASE M_BH = '03'
 TMP_BH = '(表二    )'
 CASE M_BH = '02'
 TMP_BH = '(表三    )'
 CASE M_BH = '06'
 TMP_BH = '(表四    )'
 CASE M_BH = '05'
 TMP_BH = '(表五之一)'
 CASE M_BH = '04'
 TMP_BH = '(表五之二)'
 CASE M_BH = '07'
 TMP_BH = '(表五之五)'
 CASE M_BH = '08'
 TMP_BH = '(表五之三)'
 CASE M_BH = '19'
 TMP_BH = '(表五之四)'
 CASE M_BH = '20'
 TMP_BH = '(表五之五)'
 CASE M_BH = '21'
 TMP_BH = '(表五之六)'
 CASE M_BH = '99'
 TMP_BH = '(表六    )'
 CASE M_BH = '98'
 TMP_BH = '(表七    )'
 ENDCASE 
 ENDIF 
 USE .\bbbt
 ZAP 
 USE 
 INSERT INTO bbbt VALUES ( MM_BT , DWMC , BBXZ1 , BBXZ2 , BBXZ3 , TMP_RQ , DW , TMP_YS ,  ;
      TMP_BH , TMP_DYYS )
 FOR DYJ_Y = 1 TO DY_S
 FOR K = 1 TO I
 IF TYPE(BTM(K)) = 'C'
  ?? &BTM(k)
 ENDIF 
 ENDFOR 
 SELECT 7
  USE &ysyml.\lib\B&SS..dat   
 GO WEZH - 1
 PP = ALLTRIM(P)
 FOR DY_J = 1 TO H_DY
 SELECT 4
  USE &ysyml.\dat\DY_DATA.dat
 SELECT 3
 DY_DU = ''
  USE &ysyml.\lib\BT2.dat
 DY_DU = ''
 FOR JSI = 1 TO JDS - 1
 DY_DU = DY_DU + DYDD(JSI,1)
 DY_C = OCCURS(DYDD(JSI,1),DY_DU)
 IF DY_C > CISHU
 DY_C = CISHU
 ENDIF 
 IF DY_C < OCCURS('xmmc',DY_DU)
 DY_C = OCCURS('xmmc',DY_DU)
 ENDIF 
 SELECT 4
 IF H_DY * (DY_C - 1) + DY_J > RECCOUNT()
 APPEND BLANK
 ELSE 
 GO H_DY * (DY_C - 1) + DY_J
 ENDIF 
  array_rep(jsi)=&dydd(jsi,1)
 ENDFOR 
 INSERT INTO rep_table FROM ARRAY ARRAY_REP
 ENDFOR 
 IF M_BH = '09'
 TMP_WEI = .T.
 SELECT REP_TABLE
 REC_XH = 0
 GO BOTTOM
 DO WHILE TMP_WEI
 IF DH1 = SPACE(6) AND XM1 = SPACE(50) AND DH2 = SPACE(6) AND XM2 = SPACE(50) AND  ;
DH3 = SPACE(6) AND XM3 = SPACE(50)
 REC_XH = RECNO()
 SKIP -1
 ELSE 
 TMP_WEI = .F.
 ENDIF 
 ENDDO 
 IF REC_XH <> 0
 GO REC_XH
 DELETE REST
 PACK 
 ENDIF 
 ENDIF 
 USE 
 BCMEM = ''
  USE &ysyml.\dat\dy_fata.dat   
 IF RECCOUNT() <> 0
 USE 
 DO DYBC
 ENDIF 
 USE 
 IF BBBZ = 1
 USE bczl
 REPLACE BCZL WITH  ;
      '   行长(主任)                                 处(科)长                                 复核                               制表'
 USE 
 BCMEM =  ;
      BCMEM + CHR(13) +  ;
'   行长(主任)                                 处(科)长                                 复核                               制表'
 USE bc_mem
 GO 1
 REPLACE KKMEM WITH BCMEM
 USE 
 ELSE 
 BCMEM = BCMEM + CHR(13) + '  数   据   不   平 ！'
 USE bc_mem
 GO 1
 REPLACE KKMEM WITH BCMEM
 USE 
 USE bczl
 REPLACE BCZL WITH '   数 据 不 平 !'
 USE 
 ENDIF 
 FOR K = 1 TO CSHKZ
 IF TYPE(CS(K)) = 'C'
 ?? CS(K)
 ENDIF 
 ENDFOR 
 SELECT 4
  USE &ysyml.\dat\DY_DATA.dat
 DELETE FOR RECNO() <= H_DY * CISHU
 PACK 
 ENDFOR 
ENDPROC
*------
PROCEDURE bb
 JSI = 1
  USE &ysyml.\lib\bt2.dat
 SCAN FOR BH = SS
 IF EMPTY(ZDMC)
 LOOP 
 ENDIF 
 SKIP 
 DYDC = CHANGDU
 SKIP -1
 DYDD( JSI , 4 ) = DYDC - CHANGDU - 2
 DYDD( JSI , 1 ) = ZDMC
 SELECT 8
  USE &ysyml.\lib\blk.dat
 LOCATE FOR BH = SS AND FIELD_NAME = DYDD(JSI,1)
 DYDD( JSI , 2 ) = FIELD_TYPE
 DYDD( JSI , 3 ) = FIELD_LEN
 IF DYDD(JSI,2) = 'N' .OR. DYDD(JSI,2) = 'n'
 DDC = DYDD(JSI,4) - 3
 DC = INT(DDC / 4)
 DCC = INT((DDC - 1) / 4)
 XX = ''
 DO CASE 
 CASE DDC - DC * 4 = 1
 XX = '@Z ' + '#' + REPLICATE(',###',DCC)
 CASE DDC - DC * 4 = 2
 XX = '@Z ' + '##' + REPLICATE(',###',DCC)
 CASE DDC - DC * 4 = 3
 XX = '@Z ' + '###' + REPLICATE(',###',DCC)
 CASE DDC - DC * 4 = 0
 XX = '@Z ' + '####' + REPLICATE(',###',DCC)
 ENDCASE 
 XX = XX + '.##'
 DYDD( JSI , 5 ) = XX
 ENDIF 
 JSI = JSI + 1
 ENDSCAN 
ENDPROC
*------
PROCEDURE S_DY
 SELECT 9
  USE &ysyml.\lib\XM&SS..dat
 SELECT 4
  USE &ysyml.\dat\dyls
  JOIN WITH I TO &ysyml.\DAT\DY_DATA.DAT FOR XMDH=I->XMDH 
 SELECT 4
  USE &ysyml.\dat\DY_DATA.dat
 REPLACE XMDH WITH '      ' FOR  ;
      LEFT(ALLTRIM(XMDH),1) = 'A' .OR. LEFT(ALLTRIM(XMDH),1) = 'a'
  COPY TO &ysyml.\dat\DY_FATA.dat FOR LEFT(ALLT(XMDH),1)="B" OR LEFT(ALLT(XMDH),1)="b"
 DELETE FOR LEFT(ALLTRIM(XMDH),1) = 'B' .OR. LEFT(ALLTRIM(XMDH),1) = 'b'
 PACK 
ENDPROC
*------
PROCEDURE DYBC
 SELECT 4
  USE &ysyml.\lib\BBT1.dat
 LOCATE FOR BH = SS
 IF  .NOT. EOF()
 ELSE 
 DO DYBC2
 ENDIF 
ENDPROC
*------
PROCEDURE DYBC1
 WEZH1 = WZ
 SELECT 3
 CHANG = ''
  USE &ysyml.\lib\Bbt2.dat
 SCAN FOR BH = SS
 CHANG = CHANG + ZDMC
 ENDSCAN 
 CISH = OCCURS('xmmc',CHANG)
 IF CISH = 0
 = MESSAGEBOX('补充资料表体库设置有误,不能找到项目名称',0,'提示信息')
 RETURN 
 ENDIF 
 SELECT 4
  USE &ysyml.\lib\BB&SS..dat
 INSERT INTO bczl VALUES ( '  补充资料:' )
 GO WEZH1 - 1
 PP = ALLTRIM(P)
  USE &ysyml.\dat\DY_FATA.dat
 DY_DD = INT(RECCOUNT() / CISH)
 IF RECCOUNT() > DY_DD * CISH
 DY_DD = DY_DD + 1
 ENDIF 
 USE 
 FOR DY_J = 1 TO DY_DD
 SELECT 3
  USE &ysyml.\lib\BBT2.dat
 DY_DU = ''
 BC_STR = ''
 SCAN FOR BH = SS
 IF EMPTY(ZDMC)
 LOOP 
 ENDIF 
 SKIP 
 DY_CD = CHANGDU
 SKIP -1
 DY_DU = DY_DU + ZDMC
 DY_ZDM = ZDMC
 SELECT 8
  USE &ysyml.\lib\blk.dat
 LOCATE FOR BH = SS AND FIELD_NAME = DY_ZDM
 DY_LX = FIELD_TYPE
  USE &ysyml.\dat\DY_FATA.dat
 DY_C = OCCURS(DY_ZDM,DY_DU)
 IF DY_C > CISH
 DY_C = CISH
 ENDIF 
 IF DY_DD * (DY_C - 1) + DY_J > RECCOUNT()
 APPEND BLANK
 ENDIF 
 GO DY_DD * (DY_C - 1) + DY_J
 DY_CD = DY_CD - PCOL()
 IF DY_LX = 'N' .OR. DY_LX = 'n'
 DDC = DY_CD - 3
 DC = INT(DDC / 4)
 DCC = INT((DDC - 1) / 4)
 XX = ''
  bc_str=bc_str + &DY_ZDM
 ELSE 
  bc_str=bc_str + &DY_ZDM
 ENDIF 
 BC_STR = BC_STR + '|'
 ENDSCAN 
 IF DY_G AND DY_J < DY_DD
 SELECT 3
  USE &ysyml.\lib\BBT2.dat         
 @ PROW() + 1 , 1 SAY '┠'
 XXXP = 0
 SCAN FOR BH = SS
 SKIP 
 DY_CD = CHANGDU
 IF EMPTY(ZDMC)
 XXXP = 1
 ENDIF 
 SKIP -1
 IF EMPTY(ZDMC)
 LOOP 
 ENDIF 
 @ PROW() , PCOL() SAY REPLICATE('-',(DY_CD - PCOL()) / 2)
 IF XXXP = 0
 @ PROW() , PCOL() SAY '┼'
 ENDIF 
 ENDSCAN 
 @ PROW() , PCOL() SAY '┤'
 ENDIF 
 ENDFOR 
  USE &ysyml.\lib\BB&SS..dat
 GO WEZH1 + 1
 @ PROW() + 1 , 1 SAY ALLTRIM(P)
 USE 
ENDPROC
*------
PROCEDURE DYBC2
 MMM = 0
 BCMEM = BCMEM + '  补充资料:'
 SELECT 4
  USE &ysyml.\dat\DY_FATA.dat
 DY_DD = INT(RECCOUNT() / 2)
 IF RECCOUNT() > DY_DD * 2
 DY_DD = DY_DD + 1
 ENDIF 
 FOR DY_J = 1 TO DY_DD
 FOR DY_JJ = 1 TO 2
 SELECT 4
 IF DY_DD * (DY_JJ - 1) + DY_J > RECCOUNT()
 APPEND BLANK
 ENDIF 
 GO DY_DD * (DY_JJ - 1) + DY_J
 IF SS = '03'
 BCMEM = BCMEM + SPACE(8) + ALLTRIM(XMMC)
 ELSE 
 BCMEM = BCMEM + SPACE(15) + XMMC
 ENDIF 
 IF DY_J = 1 AND DY_JJ = 1 AND (SS = '05' .OR. SS = '21')
 BCMEM = BCMEM + SPACE(13)
 ENDIF 
 SELECT 8
  USE &ysyml.\lib\BLK.dat
 SCAN FOR BH = SS
 IF FIELD_TYPE = 'N' .OR. FIELD_TYPE = 'n'
 MMM = MMM + 1
 DY_ZDM = FIELD_NAME
 DY_CD = FIELD_LEN
 IF DY_CD > 6
 SELECT 4
  IF &DY_ZDM !=0   
 DDC = DY_CD - 3
 DC = INT(DDC / 4)
 DCC = INT((DDC - 1) / 4)
 XX = ''
 DO CASE 
 CASE DDC - DC * 4 = 1
 XX = '@Z ' + '#' + REPLICATE(',###',DCC)
 CASE DDC - DC * 4 = 2
 XX = '@Z ' + '##' + REPLICATE(',###',DCC)
 CASE DDC - DC * 4 = 3
 XX = '@Z ' + '###' + REPLICATE(',###',DCC)
 CASE DDC - DC * 4 = 0
 XX = '@Z ' + '####' + REPLICATE(',###',DCC)
 ENDCASE 
 XX = XX + '.##'
  IF len(allt(str(100*(&dy_zdm-int(&dy_zdm)))))=1
  weicheng='0'+allt(str(100*(&dy_zdm-int(&dy_zdm))))
 ELSE 
  weicheng=allt(str(100*(&dy_zdm-int(&dy_zdm))))
 ENDIF 
 IF SS = '03'
  bcmem=bcmem +  str(int(&DY_ZDM)) + '.' +weicheng + " 元"
 ELSE 
  bcmem=bcmem +  str(int(&DY_ZDM)) + '.' +weicheng 
 ENDIF 
 ENDIF 
 ENDIF 
 ENDIF 
 ENDSCAN 
 ENDFOR 
 IF SS = '03'
 BCMEM = BCMEM
 ELSE 
 BCMEM = BCMEM + CHR(13)
 ENDIF 
 ENDFOR 
ENDPROC
*------
PROCEDURE dqxz1
 SELECT 4
  USE &ysyml.\DAT\H&SS&xNIAN..DAT
  LOCA FOR Dqdh=&YUE .AND. DA1=0 .and. xmdh="dpbz".and. blx2=b_lx2 .and. allt(blx1)=allt(str(m_blx1))
 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 
ENDPROC
*------
PROCEDURE nianx
 M_JSQ1 = LEN(M_P)
 M_JSQ2 = 0
 M_JSQ3 = 0
 IF VAL(XNIAN) > 90
 NIANA = '19' + XNIAN
 ELSE 
 NIANA = '20' + XNIAN
 ENDIF 
 NIAN1 = RIGHT(ALLTRIM(STR(VAL(NIANA) - 3)),2)
 NIAN2 = RIGHT(ALLTRIM(STR(VAL(NIANA) - 2)),2)
 NIAN3 = RIGHT(ALLTRIM(STR(VAL(NIANA) - 1)),2)
 FOR N = 1 TO 3
 M_NIAN = 'xNIAN' + ALLTRIM(STR(N))
 M_NIANA = 'NIANS' + ALLTRIM(STR(N))
 M_N1 = ' '
 M_NN = '  '
  M_N1=LEFT(&M_NIAN,1)
 DO NI
 PM = M_NN
  M_N1=RIGHT(&M_NIAN,1)
 DO NI
  &M_NIANA=PM+M_NN
 ENDFOR 
 FOR N = 1 TO 2
 M_JSQ2 = AT('0A01',M_P)
 IF M_JSQ2 <> 0
 M_JSQ3 = M_JSQ1 - M_JSQ2 - 3
 M_P1 = LEFT(M_P,M_JSQ2 - 1)
 M_P2 = RIGHT(M_P,M_JSQ3)
 M_P = M_P1 + NIANS1 + M_P2
 ENDIF 
 ENDFOR 
 FOR N = 1 TO 2
 M_JSQ2 = AT('0A02',M_P)
 IF M_JSQ2 <> 0
 M_JSQ3 = M_JSQ1 - M_JSQ2 - 3
 M_P1 = LEFT(M_P,M_JSQ2 - 1)
 M_P2 = RIGHT(M_P,M_JSQ3)
 M_P = M_P1 + NIANS2 + M_P2
 ENDIF 
 ENDFOR 
 FOR N = 1 TO 2
 M_JSQ2 = AT('0A03',M_P)
 IF M_JSQ2 <> 0
 M_JSQ3 = M_JSQ1 - M_JSQ2 - 3
 M_P1 = LEFT(M_P,M_JSQ2 - 1)
 M_P2 = RIGHT(M_P,M_JSQ3)
 M_P = M_P1 + NIANS3 + M_P2
 ENDIF 
 ENDFOR 
ENDPROC
*------
PROCEDURE NI
 DO CASE 
 CASE M_N1 = '1'
 M_NN = '一'
 CASE M_N1 = '2'
 M_NN = '二'
 CASE M_N1 = '3'
 M_NN = '三'
 CASE M_N1 = '4'
 M_NN = '四'
 CASE M_N1 = '5'
 M_NN = '五'
 CASE M_N1 = '6'
 M_NN = '六'
 CASE M_N1 = '7'
 M_NN = '七'
 CASE M_N1 = '8'
 M_NN = '八'
 CASE M_N1 = '9'
 M_NN = '九'
 CASE M_N1 = '0'
 M_NN = '零'
 ENDCASE 
ENDPROC
*------*