dy99.prg

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

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


 USE LIB\DYZK.DAT
 LOCATE FOR DYBZ = .T.
 M_DYJH = DYJH
 USE 
 SET ESCAPE ON
 SET TALK OFF
 SET STATUS OFF
 SET SCOREBOARD OFF
 SET SAFETY OFF
 DYJM = 'PRN       '
 BTMM = ''
 ZWMM = ''
 CSMM = ''
 DY_HJJ = ''
 DY_ZJJ = ''
 DY_RDY = 'Y'
 DY_S1 = 1
 DY_S2 = 1
 DY_S2M = 1
 RESTORE FROM BTT.MEM ADDITIVE
 BBXZ = '   '
 USE LIB\BZL.DAT
 M_BH = '99'
 SS = '99'
 LOCATE FOR BH = SS
 M_BM = LTRIM(TRIM(BM))
 USE 
 BBXZ3 = ''
 M_BLX1 = 0
 Q_QUIT = .F.
 DO FORM src\form\bbdy
 IF Q_QUIT
 RETURN 
 CLOSE DATABASES 
 ENDIF 
 DO CASE 
 CASE M_BLX1 = 1
 BBXZ3 = '月 报'
 CASE M_BLX1 = 2
 BBXZ3 = '季 报'
 CASE M_BLX1 = 3
 BBXZ3 = '年 报'
 CASE M_BLX1 = 4
 BBXZ3 = '半年报'
 ENDCASE 
 CL_NIAN = RIGHT(NIAN,2)
  IF !fiLE("DAT\b&ss&cl_nian&yue..DAT") OR !fiLE("DAT\b01&cl_nian&yue..DAT")  
 MSGTTL = '报表选择'
 MESSGTXT = '报表数据不存在!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 IF  .NOT. FILE('LIB\XM01.DAT') .OR.  .NOT. FILE('LIB\XM99.DAT')
 MSGTTL = '报表选择'
 MESSGTXT = '报表数据不存在!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 IF  .NOT. FILE('LIB\ZB99.DAT') .OR.  .NOT. FILE('LIB\ZB99A.DAT') .OR.  ;
 .NOT. FILE('LIB\ZB99B.DAT') .OR.  .NOT. FILE('LIB\DY99TMP.DAT')
 MSGTTL = '报表选择'
 MESSGTXT = '科目关系数据不存在!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 RESTORE FROM qq.mem ADDITIVE
 HZH = QQ
 DO FORM .\src\form\dqxza
 IF DQXZ < 4
  IF !FILE("DAT\H&SS&cl_NIAN..DAT") or !FILE("DAT\H01&cl_NIAN..DAT")
 MSGTTL = '报表选择'
 MESSGTXT = '汇总数据文件不存在! '
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 
 ENDIF 
 SELECT 9
  use lib\xm&ss..dat
 JLS2 = RECCOUNT()
 SELECT 10
 USE lib\xm01.dat
 JLS3 = 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
 SELECT 4
  USE DAT\H&SS&cl_nian..DAT
  LOCA FOR DQDH=&YUE .AND. DA1=0 .AND. XMDH="dpbz" .and. VAL(BLX1)=M_BLX1 
 IF EOF()
 MSGTTL = '报表选择'
 MESSGTXT = '汇总数据不存在! '
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ELSE 
 BBBZ = SJDW
 JLS1 = RECNO()
 COPY TO DAT\dy99a FOR RECNO() > JLS1 AND RECNO() <= JLS2 + JLS1
 SELECT 5
  USE DAT\H01&cl_nian..DAT
  LOCA FOR DQDH=&YUE .AND. DA1=0 .AND. XMDH="dpbz" .and. VAL(BLX1)=M_BLX1 
 IF EOF()
 MSGTTL = '报表选择'
 MESSGTXT = '汇总数据不存在! '
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ELSE 
 BBXZ1 = '全 辖 汇 总 '
 JLS1 = RECNO()
 COPY TO DAT\dy99b FOR RECNO() > JLS1 AND RECNO() <= JLS3 + JLS1
 DO XZYS
 IF DY_RDY = 'N' .OR. DY_RDY = 'n'
 RETURN 
 ENDIF 
 DO src\prg\DY99ZH
 DO DY99B
 ENDIF 
 ENDIF 
 CASE DQXZ = 2
 SELECT 4
  USE DAT\H&SS&cl_nian..DAT
  LOCA FOR DQDH=&YUE .AND. DA1=1 .AND. XMDH="dpbz" .and. VAL(BLX1)=M_BLX1 
 IF EOF()
 MSGTTL = '报表选择'
 MESSGTXT = '汇总数据不存在! '
 RETURN 
 ELSE 
 BBBZ = SJDW
 JLS1 = RECNO()
 COPY TO DAT\dy99a FOR RECNO() > JLS1 AND RECNO() <= JLS2 + JLS1
 SELECT 5
  USE DAT\H01&cl_nian..DAT
  LOCA FOR DQDH=&YUE .AND. DA1=1 .AND. XMDH="dpbz" .and. VAL(BLX1)=M_BLX1 
 IF EOF()
 MSGTTL = '报表选择'
 MESSGTXT = '汇总数据不存在! '
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ELSE 
 BBXZ1 = '单 列 汇 总 '
 JLS1 = RECNO()
 COPY TO DAT\dy99b FOR RECNO() > JLS1 AND RECNO() <= JLS3 + JLS1
 DO XZYS
 IF DY_RDY = 'N' .OR. DY_RDY = 'n'
 RETURN 
 ENDIF 
 DO src\prg\DY99ZH
 DO DY99B
 ENDIF 
 ENDIF 
 CASE DQXZ = 3
 SELECT 4
  USE DAT\H&SS&cl_nian..DAT
  LOCA FOR DQDH=&YUE .AND. DA1=2 .AND. XMDH="dpbz" .and. VAL(BLX1)=M_BLX1 
 IF EOF()
 MSGTTL = '报表选择'
 MESSGTXT = '汇总数据不存在! '
 RETURN 
 ELSE 
 BBBZ = SJDW
 JLS1 = RECNO()
 COPY TO DAT\dy99a FOR RECNO() > JLS1 AND RECNO() <= JLS2 + JLS1
 SELECT 5
  USE DAT\H01&cl_nian..DAT
  LOCA FOR DQDH=&YUE .AND. DA1=2 .AND. XMDH="dpbz" .and. VAL(BLX1)=M_BLX1 
 IF EOF()
 MSGTTL = '报表选择'
 MESSGTXT = '汇总数据不存在! '
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ELSE 
 XZ1 = '非 单 列 汇 总 '
 JLS1 = RECNO()
 COPY TO DAT\dy99b FOR RECNO() > JLS1 AND RECNO() <= JLS3 + JLS1
 DO XZYS
 IF DY_RDY = 'N' .OR. DY_RDY = 'n'
 RETURN 
 ENDIF 
 DO src\prg\DY99ZH
 DO DY99B
 ENDIF 
 ENDIF 
 CASE DQXZ = 4
 BBXZ1 = '             '
 DQ1 = 0
 DQ2 = 0
 DO FORM .\src\form\xzdydq
 SELECT 2
 USE lib\DQK.dat
 FOR I_YXL = DQ1 TO DQ2
 SELECT 2
 USE lib\DQK.dat
 LOCATE FOR DQDH = I_YXL
 IF EOF()
 LOOP 
 ELSE 
 HZH = DQMC
 SELECT 4
  USE DAT\B&SS&cl_nian&YUE..DAT
 LOCATE FOR DQDH = I_YXL AND VAL(BLX1) = M_BLX1 AND XMDH = 'dpbz'
 IF EOF()
 CLEAR 
 MSGTTL = '报表选择'
 MESSGTXT = STR(I_YXL,3) + ' 地区数据不存在!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 LOOP 
 ENDIF 
 JLS1 = RECNO()
 BBBZ = SJDW
 COPY TO DAT\dy99a FOR RECNO() > JLS1 AND RECNO() <= JLS2 + JLS1
 SELECT 5
  USE DAT\B01&cl_nian&YUE..DAT
 LOCATE FOR DQDH = I_YXL AND VAL(BLX1) = M_BLX1 AND XMDH = 'dpbz'
 IF EOF()
 CLEAR 
 MSGTTL = '报表选择'
 MESSGTXT = STR(I_YXL,3) + ' 地区数据不存在!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 LOOP 
 ENDIF 
 JLS1 = RECNO()
 COPY TO DAT\dy99b FOR RECNO() > JLS1 AND RECNO() <= JLS3 + JLS1
 DO XZYS
 IF DY_RDY = 'N' .OR. DY_RDY = 'n'
 RETURN 
 ENDIF 
 DO src\prg\DY99ZH
 DO DY99B
 ENDIF 
 ENDFOR 
 CASE DQXZ = 5
 RETURN 
 ENDCASE 
 CLOSE DATABASES 

PROCEDURE XZYS
 SELECT 20
 USE lib\dyfy.dat
 LOCATE FOR BH = '99'
 IF FY > 1 AND  .NOT. EOF()
 DO FORM .\src\form\xzys
 DYJM = ALLTRIM(DYJM)
 IF DYJM == 'PRN' .OR. DYJM == 'prn'
 DO DYAA
 DY_RDY = 'Y'
 IF  .NOT. PRINTSTATUS()
 DO FORM .\src\form\dyjcs
 ENDIF 
 IF DY_RDY = 'n' .OR. DY_RDY = 'N'
 RETURN 
 ENDIF 
 ELSE 
 STORE '' TO BTMM , ZWMM , CSMM , DY_HJJ , DY_ZJJ
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE xzysoff
 SET PRINTER OFF
 SET DEVICE TO SCREEN
ENDPROC
*------
PROCEDURE dyaa
 SELECT 6
 USE lib\DYJ.dat
 LOCATE FOR DYJH = M_DYJH AND BH = M_BH
 BTMM = ALLTRIM(BTM)
 ZWMM = ALLTRIM(ZWM)
 CSMM = ALLTRIM(CSH)
 DY_HJJ = ALLTRIM(HJM)
 DY_ZJJ = ALLTRIM(ZJM)
ENDPROC
*------
PROCEDURE ret
 SET PRINTER OFF
 SET DEVICE TO SCREEN
 CLOSE DATABASES 
 DEACTIVATE WINDOW YXL3
 ON ERROR 
 RETURN TO MASTER 
ENDPROC
*------
PROCEDURE dy99b
 CLOSE DATABASES 
 SET DEVICE TO PRINTER
 SET PRINTER TO xxx.txt
 SET PRINTER ON
 SELECT 1
 USE lib\dy99tmp.dat
 M1 =  ;
      '┏━━━━━━━━━━━━━━━━━┯━━━━━━━━━━━━━━━━━━━━━━━┯━━━━━━━━━━━━━━━━━┯━━━━━━━━━━━━━━━━━━━━━━━┓'
 M2 =  ;
      '┃        旧      科      目        │             金                 额            │        新      科      目        │            金                   额           ┃'
 M3 =  ;
      '┠───┬─────────────┼───────────┬───────────┼───┬─────────────┼───────────┬───────────┨'
 M4 =  ;
      '┃代  号│      名       称         │      借      方      │      贷       方     │代  号│      名       称         │      借      方      │      贷       方     ┃'
 M5 =  ;
      '┠───┼─────────────┼───────────┼───────────┼───┼─────────────┼───────────┼───────────┨'
 M51 =  ;
      '┠───┼─────────────┼───────────┼───────────┤'
 M6 =  ;
      '┃      │                          │                      │                      │'
 M7 =  ;
      '┃      │                          │                      │                      │'
 M71 =  ;
      '┃      │                          │                      │                      │'
 M8 =  ;
      '┠───┼─────────────┼───────────┼───────────┤'
 M9 =  ;
      '┃      │                          │                      │                      │'
 M10 =  ;
      '┗━━━┷━━━━━━━━━━━━━┷━━━━━━━━━━━┷━━━━━━━━━━━┷━━━┷━━━━━━━━━━━━━┷━━━━━━━━━━━┷━━━━━━━━━━━┛'
 M11 = '┃'
 M12 = '│'
 FOR AM = DY_S1 TO DY_S2
 M_YE = ''
 MMM1 = INT(RECCOUNT() / DY_S2M * AM - RECCOUNT() / DY_S2M + 1)
 MMM2 = INT(RECCOUNT() / DY_S2M * AM)
 IF MMM1 <> 1
 MMM1 = MMM1 + 4
 ENDIF 
 IF DY_S2M > 1
 M_YE = '共 ' + ALLTRIM(STR(DY_S2M)) + ' 页   第 ' + ALLTRIM(STR(AM)) + ' 页'
 ENDIF 
  ??&CSmm
  ?&btmm
 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 
 USE .\bbbt
 GO TOP
 REPLACE B_BM WITH MM_BT
 USE 
  ??&zwmm
  ??&DY_HJJ
  ??&DY_ZJJ
 @ PROW() + 1 , 3 SAY '单位名称:'
 @ PROW() , PCOL() + 3 SAY HZH
 @ PROW() , PCOL() SAY BBXZ1
 @ PROW() , PCOL() SAY BBXZ3
 @ PROW() , PCOL() + 28 SAY NIAN
 @ PROW() , PCOL() + 2 SAY '年'
 @ PROW() , PCOL() + 3 SAY YUE
 @ PROW() , PCOL() + 2 SAY '月'
 @ PROW() , PCOL() + 30 SAY DW
 @ PROW() , PCOL() + 10 SAY M_YE
 @ PROW() , PCOL() + 3 SAY '(表六    )'
 @ PROW() + 1 , 2 SAY M1
 @ PROW() + 1 , 2 SAY M2
 @ PROW() + 1 , 2 SAY M3
 @ PROW() + 1 , 2 SAY M4
 @ PROW() + 1 , 2 SAY M5
 ON ERROR 
 FOR N = MMM1 TO MMM2
 IF MMM1 = 1
 IF N = MMM2 - 1
 GO N - 1
 IF BZ1 = .T. AND BZ2 = .T.
 EXIT 
 ENDIF 
 ENDIF 
 IF N = MMM2
 EXIT 
 ENDIF 
 ELSE 
 IF N = RECCOUNT() - 1
 GO RECCOUNT() - 1
 IF BZ1 = .T. AND BZ2 = .T.
 EXIT 
 ENDIF 
 ENDIF 
 IF N >= RECCOUNT()
 EXIT 
 ENDIF 
 ENDIF 
 USE lib\dy99tmp.dat
 GO N
 IF BZ1 = .T. AND BZ2 = .T.
 @ PROW() + 1 , 2 SAY M5
 ELSE 
 IF LEN(ALLTRIM(XMDH2)) = 0 AND LEN(ALLTRIM(XMDH1)) = 0
 IF BZ1 = .T. AND BZ2 = .F.
 @ PROW() + 1 , 2 SAY M6 + M8
 ELSE 
 IF BZ1 = .F. AND BZ2 = .T.
 @ PROW() + 1 , 2 SAY M51 + M71
 ELSE 
 @ PROW() + 1 , 2 SAY M6 + M7
 ENDIF 
 ENDIF 
 ELSE 
 IF LEN(ALLTRIM(XMDH2)) = 0
 IF BZ2 = .T.
 @ PROW() + 1 , 2 SAY M51
 ELSE 
 @ PROW() + 1 , 2 SAY M6
 @ PROW() , PCOL() SAY M12
 ENDIF 
 IF SUBSTR(XMDH1,LEN(ALLTRIM(XMDH1)),1) = 'a' .OR.  ;
SUBSTR(XMDH1,LEN(ALLTRIM(XMDH1)),1) = 'b' .OR. SUBSTR(XMDH1,LEN(ALLTRIM(XMDH1)),1) = 'c'
 XMDHA = ALLTRIM(LEFT(XMDH1,LEN(ALLTRIM(XMDH1)) - 1)) + '  '
 @ PROW() , PCOL() SAY XMDHA PICTURE 'XXXXXX'
 ELSE 
 @ PROW() , PCOL() SAY XMDH1 PICTURE 'xxxxxx'
 ENDIF 
 @ PROW() , PCOL() SAY M12
 @ PROW() , PCOL() SAY XMMC1 PICTURE 'xxxxxxxxxxxxxxxxxxxxxxxxxx'
 @ PROW() , PCOL() SAY M12
 IF DA11 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA11 PICTURE '################.##'
 ENDIF 
 @ PROW() , PCOL() SAY M12
 IF DA12 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA12 PICTURE '################.## '
 ENDIF 
 @ PROW() , PCOL() SAY M11
 ELSE 
 IF LEN(ALLTRIM(XMDH1)) = 0
 @ PROW() + 1 , 2 SAY M11
 @ PROW() , PCOL() SAY XMDH2 PICTURE 'xxxxxx'
 @ PROW() , PCOL() SAY M12
 @ PROW() , PCOL() SAY XMMC2 PICTURE 'xxxxxxxxxxxxxxxxxxxxxxxxxx'
 @ PROW() , PCOL() SAY M12
 IF DA21 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA21 PICTURE '################.##'
 ENDIF 
 @ PROW() , PCOL() SAY M12
 IF DA22 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA22 PICTURE '################.##'
 ENDIF 
 IF BZ1 = .T.
 @ PROW() , PCOL() SAY M8
 ELSE 
 @ PROW() , PCOL() SAY M7
 ENDIF 
 ELSE 
 @ PROW() + 1 , 2 SAY M11
 @ PROW() , PCOL() SAY XMDH2 PICTURE 'xxxxxx'
 @ PROW() , PCOL() SAY M12
 @ PROW() , PCOL() SAY XMMC2 PICTURE 'xxxxxxxxxxxxxxxxxxxxxxxxxx'
 @ PROW() , PCOL() SAY M12
 IF DA21 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA21 PICTURE '################.##'
 ENDIF 
 @ PROW() , PCOL() SAY M12
 IF DA22 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA22 PICTURE '################.##'
 ENDIF 
 @ PROW() , PCOL() SAY M12
 IF SUBSTR(XMDH1,LEN(ALLTRIM(XMDH1)),1) = 'a' .OR.  ;
SUBSTR(XMDH1,LEN(ALLTRIM(XMDH1)),1) = 'b' .OR. SUBSTR(XMDH1,LEN(ALLTRIM(XMDH1)),1) = 'c'
 XMDHA = ALLTRIM(LEFT(XMDH1,LEN(ALLTRIM(XMDH1)) - 1)) + '  '
 @ PROW() , PCOL() SAY XMDHA PICTURE 'XXXXXX'
 ELSE 
 @ PROW() , PCOL() SAY XMDH1 PICTURE 'xxxxxx'
 ENDIF 
 @ PROW() , PCOL() SAY M12
 @ PROW() , PCOL() SAY XMMC1 PICTURE 'xxxxxxxxxxxxxxxxxxxxxxxxxx'
 @ PROW() , PCOL() SAY M12
 IF DA11 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA11 PICTURE '################.##'
 ENDIF 
 @ PROW() , PCOL() SAY M12
 IF DA12 = 0
 @ PROW() , PCOL() SAY '                        '
 ELSE 
 @ PROW() , PCOL() SAY DA12 PICTURE '################.##'
 ENDIF 
 @ PROW() , PCOL() SAY M11
 ENDIF 
 ENDIF 
 ENDIF 
 ENDIF 
 ENDFOR 
 @ PROW() + 1 , 2 SAY M10
 IF BBBZ = 1
 @ PROW() + 2 , 10 SAY '  行长(主任)'
 @ PROW() , PCOL() + 30 SAY '  处(科)长'
 @ PROW() , PCOL() + 30 SAY '      复核'
 @ PROW() , PCOL() + 30 SAY '      制表'
 ELSE 
 @ PROW() + 2 , 10 SAY ' 数 据 不 平 !'
 ENDIF 
 @ 0 , 0 SAY ''
 ENDFOR 
 SET PRINTER OFF
 SET DEVICE TO SCREEN
 SET PRINTER TO
  use &xsyml.\lreport.dbf
 ZAP 
 APPEND FROM xxx.txt SDF 
 GO TOP
 DO WHILE .T.
 IF NR = SPACE(254)
 DELETE 
 SKIP 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 PACK 
 USE 
 REPORT FORM src\rpt\zbdy99 PREVIEW 
 RETURN 
ENDPROC
*------*