dykm.prg

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

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


 YSYML = '.'
 XSYML = '.'
 XNIAN = RIGHT(NIAN,2)
 B_LX1 = '0'
 B_LX2 = '0'
 M_TC = ''
 CLOSE DATABASES 
 SET TALK OFF
 SET SAFETY OFF
 DIMENSION BTM( 10 ) , ZWM( 10 )
 STORE 1 TO III , ZWMKZ
  USE &ysyml.\LIB\DYZK.DAT
 LOCATE FOR DYBZ = .T.
 M_DYJH = DYJH
 USE 
 SQ = 0
  SET DEFA TO &xsyml
  USE &ysyml.\LIB\BZL.DAT
 M_BH = '00'
  DO FORM &XSYML.\SRC\FORM\GONG2   
  USE &ysyml.\LIB\BZL.DAT
 SS = M_BH
 IF M_BH = '00'
 RETURN 
 ENDIF 
 LOCATE FOR BH = SS
 M_BM = LTRIM(TRIM(BM))
 M_BBLX2 = ''
 USE 
  DO FORM &xsyml.\SRC\FORM\dykm   
 B_LX1 = ALLTRIM(STR(M_BLX1))
 B_LX2 = ALLTRIM(STR(M_BLX2))
 IF M_TC = '退出'
 M_TC = ''
 RETURN 
 ENDIF 
 DO HBKM

PROCEDURE hbkm
 PUBLIC KM( 20 )
 STORE 0 TO ZS
 FOR XXH = 1 TO 20
 KM( XXH ) = '      '
 ENDFOR 
 XXH = 1
  DO FORM &xsyml.\SRC\FORM\hbkm    
 IF M_TC = '退出'
 M_TC = ''
 RELEASE KM
 RETURN 
 ENDIF 
 CLOSE DATABASES 
 DO DYKMZ
 RELEASE KM
ENDPROC
*------
PROCEDURE dykmz
 DIMENSION SSS( 10 ) , KMNM( 10 ) , KMHY( 10 ) , KMCD( 10 )
 FOR XXH = 1 TO 10
 STORE 0 TO SSS( XXH ) , KMCD( XXH )
 STORE '' TO KMNM( XXH ) , KMHY( XXH )
 ENDFOR 
 IF ZS = 0
 = MESSAGEBOX('无打印科目',0,'提示信息')
 RETURN 
 ENDIF 
 SELECT 2
  IF ! FILE("&ysyml.\dat\b&ss&xnian&yue..dat")
 = MESSAGEBOX('无' + YUE + '月数据!',0,'提示信息')
 RETURN 
 ENDIF 
  USE &ysyml.\dat\B&SS&xNIAN&YUE..dat   
 SELECT 3
  USE &ysyml.\lib\DQK.dat    
 COUNT TO QS
 SELECT 4
  USE &ysyml.\lib\BLK.dat   
 STORE 0 TO KL , KMD
 SCAN FOR BH = SS AND (FIELD_TYPE = 'n' .OR. FIELD_TYPE = 'N')
 IF FIELD_LEN < 4
 LOOP 
 ENDIF 
 KL = KL + 1
 KMNM( KL ) = FIELD_NAME
 KMCD( KL ) = MAX(FIELD_LEN,LEN(ALLTRIM(LHY)))
 KMHY( KL ) = LHY
 KMD = KMD + MAX(FIELD_LEN,LEN(ALLTRIM(LHY)))
 ENDSCAN 
 IF KMD > 140
 TJK = 0
 ELSE 
 TJK = INT((140 - KMD) / KL)
 ENDIF 
 AA1 = '┏━━━━━━┯━━━━━━━'
 AA2 = '┃ 地区代号   │   地区名称   '
 AA3 = '┠──────┼───────'
 AA4 = '┗━━━━━━┷━━━━━━━'
 FOR XXH = 1 TO KL
 TJK1 = INT((KMCD(XXH) + TJK) / 2)
 AA1 = AA1 + '┯'
 AA1 = AA1 + REPLICATE('━',TJK1)
 AA2 = AA2 + '│'
 AA2 = AA2 + PADC(ALLTRIM(KMHY(XXH)),TJK1 * 2)
 AA3 = AA3 + '┼'
 AA3 = AA3 + REPLICATE('─',TJK1)
 AA4 = AA4 + '┷'
 AA4 = AA4 + REPLICATE('━',TJK1)
 ENDFOR 
 AA1 = AA1 + '┓'
 AA2 = AA2 + '┃'
 AA3 = AA3 + '┨'
 AA4 = AA4 + '┛'
 DY_RDY = 'Y'
 IF  .NOT. PRINTSTATUS()
 DO FORM SRC\FORM\DYJCS
 ENDIF 
 IF DY_RDY = 'N'
 RETURN 
 ENDIF 
 SET DEVICE TO PRINTER
 SET PRINTER TO XXX.txt
  RESTORE FROM &ysyml.\qq.mem ADDI
  REST FROM &ysyml.\BTT.MEM ADDI
 HZH = QQ
 SELECT 5
  USE &ysyml.\lib\bzl.dat
 LOCATE FOR BH = SS
 BTTM = ALLTRIM(BTT) + ALLTRIM(BM)
 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( III ) = LEFT(BTMM,L - 1)
 BTMM = RIGHT(BTMM,LEN(BTMM) - L)
 III = III + 1
 ENDDO 
 BTM( III ) = 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
 @ 1 , PCOL() + 1 SAY ''
 FOR K = 1 TO III
 IF TYPE(BTM(K)) = 'C'
 ENDIF 
 ENDFOR 
 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 
 FOR K = 1 TO ZWMKZ
 IF TYPE(ZWM(K)) = 'C'
 ENDIF 
 ENDFOR 
 @ PROW() + 2 , 80 SAY NIAN
 @ PROW() , PCOL() + 2 SAY '年'
 @ PROW() , PCOL() + 2 SAY YUE
 @ PROW() , PCOL() + 2 SAY '月'
 @ PROW() , 140 SAY '报表类型: '
 DO CASE 
 CASE B_LX1 = '1'
 @ PROW() , PCOL() SAY '月报    '
 CASE B_LX1 = '2'
 @ PROW() , PCOL() SAY '季报    '
 CASE B_LX1 = '3'
 @ PROW() , PCOL() SAY '年报    '
 CASE B_LX1 = '4'
 @ PROW() , PCOL() SAY '半年报  '
 ENDCASE 
 @ PROW() , PCOL() SAY M_BBLX2
 @ PROW() + 1 , 3 SAY '打印科目:'
 @ PROW() , PCOL() + 1 SAY ALLTRIM(KM(1))
 FOR I = 2 TO ZS
 @ PROW() , PCOL() SAY '+'
 @ PROW() , PCOL() SAY ALLTRIM(KM(I))
 ENDFOR 
 SELECT 3
  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 
 @ PROW() , PCOL() + 10 SAY '单位：'
 @ PROW() , PCOL() + 1 SAY DW
 HJJ = ''
 @ PROW() + 1 , 1 SAY HJJ + AA1
 @ PROW() + 1 , 1 SAY AA2
 SELECT 3
  USE &ysyml.\lib\dqk.dat
 SCAN FOR KHBZ
 @ PROW() + 1 , 1 SAY AA3
 @ PROW() + 1 , 1 SAY '┃'
 @ PROW() , PCOL() SAY PADC(DQDH,12)
 @ PROW() , PCOL() SAY '│'
 @ PROW() , PCOL() SAY PADC(DQMC,14)
 SELECT 2
 FOR XXH = 1 TO KL
 TJK1 = INT((KMCD(XXH) + TJK) / 2)
 @ PROW() , PCOL() SAY '│'
 SELECT 2
 KMDD = TJK1 * 2 - 3
 DO CASE 
 CASE KMDD - INT(KMDD / 4) * 4 = 1
 XX = '@Z ' + '#' + REPLICATE(',###',INT((KMDD - 1) / 4))
 CASE KMDD - INT(KMDD / 4) * 4 = 2
 XX = '@Z ' + '##' + REPLICATE(',###',INT((KMDD - 1) / 4))
 CASE KMDD - INT(KMDD / 4) * 4 = 3
 XX = '@Z ' + '###' + REPLICATE(',###',INT((KMDD - 1) / 4))
 CASE KMDD - INT(KMDD / 4) * 4 = 0
 XX = '@Z ' + '####' + REPLICATE(',###',INT((KMDD - 1) / 4))
 ENDCASE 
 XX = XX + '.##'
 JS = 0
 FOR I = 1 TO ZS
 LOCATE FOR  ;
      DQDH = C.DQDH AND ALLTRIM(XMDH) == ALLTRIM(KM(I)) AND BLX1 = B_LX1 AND BLX2 = B_LX2
 KNM = KMNM(XXH)
  JS=JS+&KNM
 ENDFOR 
 @ PROW() , PCOL() SAY JS PICTURE (XX)
 SSS( XXH ) = SSS(XXH) + JS
 ENDFOR 
 @ PROW() , PCOL() SAY '┃'
 ENDSCAN 
 @ PROW() + 1 , 1 SAY AA3
 @ PROW() + 1 , 1 SAY '┃            │  合     计   '
 FOR XXH = 1 TO KL
 TJK1 = INT((KMCD(XXH) + TJK) / 2)
 @ PROW() , PCOL() SAY '│'
 KMDD = TJK1 * 2 - 3
 DO CASE 
 CASE KMDD - INT(KMDD / 4) * 4 = 1
 XX = '@Z ' + '#' + REPLICATE(',###',INT((KMDD - 1) / 4))
 CASE KMDD - INT(KMDD / 4) * 4 = 2
 XX = '@Z ' + '##' + REPLICATE(',###',INT((KMDD - 1) / 4))
 CASE KMDD - INT(KMDD / 4) * 4 = 3
 XX = '@Z ' + '###' + REPLICATE(',###',INT((KMDD - 1) / 4))
 CASE KMDD - INT(KMDD / 4) * 4 = 0
 XX = '@Z ' + '####' + REPLICATE(',###',INT((KMDD - 1) / 4))
 ENDCASE 
 XX = XX + '.##'
 @ PROW() , PCOL() SAY SSS(XXH) PICTURE (XX)
 ENDFOR 
 @ PROW() , PCOL() SAY '┃'
 @ PROW() + 1 , 1 SAY AA4
 @ PROW() + 1 , 10 SAY '      行长'
 @ PROW() , PCOL() + 30 SAY '      处长'
 @ PROW() , PCOL() + 30 SAY '      复核'
 @ PROW() , PCOL() + 30 SAY '      制表'
 @ 0 , 0 SAY ''
 SET PRINTER TO
 SET PRINTER OFF
 SET DEVICE TO SCREEN
 CLOSE DATABASES 
  USE &XSYML.\LREPORT.DBF
 ZAP 
 APPEND FROM XXX.TXT SDF 
 DELETE FOR NR = SPACE(254)
 PACK 
 USE 
 REPORT FORM src\rpt\LREPORT PREVIEW 
 RETURN 
ENDPROC
*------*