zhywsyb.prg

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

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


 CLOSE ALL
 SET TALK OFF
 SET SAFETY OFF
 SET PROCEDURE TO zhywsyb
 SET COLOR OF SCHEME 2 TO  GR+/BG,W+/BG,GR/BG,GR/BG,GR+/B,GR+/B
 DEFINE WINDOW ZH FROM 10 , 20 TO 16 , 60 COLOR SCHEME 2 SHADOW DOUBLE
 DEFINE WINDOW WRONG FROM 19 , 15 TO 21 , 65 COLOR SCHEME 2 SHADOW DOUBLE
 XSLJ = ''
 XSBM = ''
 XSYK = ''
 XSLX = ''
 XSDQ = ''
 ACTTC = 1
 DO SYBZHP

PROCEDURE sybzhp
 YEAR_A = INT(VAL(NIAN))
 MONTH_A = INT(VAL(YUE))
 DO FORM src\form\actrq
 CL_YEAR = RIGHT(YEAR_A,2)
 DO FORM src\form\dqxz
 TT = WEI
 N = AT('.',TT)
 M_DQDH = SUBSTR(TT,1,N - 1)
 IF LEN(ALLTRIM(M_DQDH)) = 1
 M_DQDH = '0' + LTRIM(TRIM(M_DQDH))
 ENDIF 
 PA = ''
 DO FORM src\form\actdrv
 IF ACTTC = 0
 PA = LEFT(PA,1)
  IF ! FILE("&pa.:SB&cl_YEAR&M_DQDH.02.DAT")
  WAIT WINDOW "财务损益报表数据不存在，请拷入&pa.盘"
 ELSE 
 DO ZHSJ
 ENDIF 
 ENDIF 
 WAIT CLEAR
ENDPROC
*------
PROCEDURE ZHSJ
 SBTMP = 'tmp\sbtmp.dat'
 IF FILE(SBTMP)
 DELETE File (SBTMP)
 ELSE 
 ENDIF 
 CREATE TABLE (SBTMP) ( DQDH C ( 6 ) , BLX1 C ( 4 ) , SBDH C ( 6 ) , XMDH C ( 6 ) , DA1  ;
      N ( 18 , 2 ) , DA2 N ( 18 , 2 ) )
 USE 
 USE IN 1 (SBTMP) ALIAS SBTMP_C
 SELECT SBTMP_C
 ZAP 
  APPE FROM &pa.:SB&cl_YEAR&M_DQDH.02.DAT type delimited with character ";"
 M_BLX1 = '0'
 M_BLX2 = '0'
 SYBLX = ' '
 SYBBBLX = ' '
 DO FORM src\form\zhywzh2
 DO CASE 
 CASE M_BLX1 = '1'
 M_BLX1_1 = '月'
 CASE M_BLX1 = '2'
 IF MONTH_A = '03'
 M_BLX1_1 = '一'
 ELSE 
 IF MONTH_A = '06'
 M_BLX1_1 = '二'
 ELSE 
 IF MONTH_A = '09'
 M_BLX1_1 = '三'
 ELSE 
 IF MONTH_A = '12'
 M_BLX1_1 = '四'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无季报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ENDIF 
 ENDIF 
 ENDIF 
 CASE M_BLX1 = '3'
 IF MONTH_A = '12'
 M_BLX1_1 = '年'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无年报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 CASE M_BLX1 = '4'
 IF MONTH_A = '06'
 M_BLX1_1 = '前'
 ELSE 
 IF MONTH_A = '12'
 M_BLX1_1 = '后'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无半年报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ENDIF 
 ENDCASE 
  IF FILE("DAT\B02&cl_YEAR&MONTH_a..DAT") 
  USE DAT\B02&cl_YEAR&MONTH_a..DAT in 2 ALIA B02  excl
 SELECT B02
 LOCATE FOR DQDH = VAL(M_DQDH) AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 IF FOUND()
 IF MESSAGEBOX('目的数据已存在! 覆盖吗 ? ( Y / N) ',36,'提示') = 7
 USE 
 RETURN 
 ELSE 
 ENDIF 
 ENDIF 
 ELSE 
  do wj with "B02&cl_YEAR&MONTH_a","02"
  USE DAT\B02&cl_YEAR&MONTH_a..DAT in 2 ALIA B02  excl
 ENDIF 
 SELECT SBTMP_C
 GO TOP
 IF VAL(SBDH) = VAL(MONTH_A) AND BLX1 = YEAR_A
 ELSE 
  MESSAGEBOX(YEAR_A - '年' - MONTH_A - '月份上报数据不存在,转换上报文件失败!!!',320,'信息提示')
 RETURN 
 ENDIF 
 LOCATE FOR XMDH = '102'
 IF DQDH <> SYBLX
  MESSAGEBOX(YEAR_A - '年' - MONTH_A - '月份上报数据无' - SYBLX - ',转换上报文件失败!!!',320,'信息提示')
 RETURN 
 ELSE 
 ENDIF 
 IF BLX1 = '月' .OR. BLX1 = ' ' .OR. BLX1 = '季' AND (VAL(MONTH_A) <> 3 .OR. VAL(MONTH_A) <> 6 .OR. VAL(MONTH_A) <> 9 .OR.  ;
VAL(MONTH_A) <> 12)
 BLX1_C = '1'
 BLX1_LB = BLX1
 ELSE 
 IF BLX1 = '一' .OR. BLX1 = '二' .OR. BLX1 = '三' .OR. BLX1 = '四'
 BLX1_C = '2'
 BLX1_LB = BLX1
 ELSE 
 IF BLX1 = '前' .OR. BLX1 = '后' .OR. BLX1 = '半年'
 BLX1_LB = BLX1
 BLX1_C = '4'
 ELSE 
 IF BLX1 = '年'
 BLX1_C = '3'
 BLX1_LB = BLX1
 ELSE 
  MESSAGEBOX('上报数据类型错误,#' - BLX1 - '#,转换上报文件失败!!!',320,'错误信息提示')
 RETURN 
 ENDIF 
 ENDIF 
 ENDIF 
 ENDIF 
 IF BLX1_C <> M_BLX1
  MESSAGEBOX(YEAR_A - '年' - MONTH_A - '月份上报数据无' - SYBBBLX - ',转换上报文件失败!!!',320,'信息提示')
 RETURN 
 ELSE 
 ENDIF 
 DO CASE 
 CASE DQDH = '盈余表'
 BLX2_C = '2'
 SYBLX = LEFT(DQDH,4)
 CASE DQDH = '亏损表'
 BLX2_C = '3'
 SYBLX = LEFT(DQDH,4)
 CASE DQDH = '合并表'
 BLX2_C = '1'
 SYBLX = LEFT(DQDH,4)
 OTHERWISE 
  MESSAGEBOX('上报数据类型错误,#' - BLX2 - '#,转换上报文件失败!!!',320,'错误信息提示')
 RETURN 
 ENDCASE 
 M_BH = '02'
 ANSWER = MESSAGEBOX('是否转换损益表类型？',292,'信息提问')
 IF ANSWER = 6
 DO FORM src\form\blx
 DO CASE 
 CASE M_BLX2 = '1'
 SYBLX = '合并'
 CASE M_BLX2 = '2'
 SYBLX = '盈余'
 CASE M_BLX2 = '3'
 SYBLX = '亏损'
 OTHERWISE 
 ENDCASE 
 SELECT SBTMP_C
 ELSE 
 ENDIF 
 IF SUBSTR(SBDH,2,2) = M_DQDH
 ELSE 
  MESSAGEBOX(YEAR_A - '年' - MONTH_A - '月份不存在' - M_DQDH - '数据,转换上报文件中断!!!',320,'错误信息提示')
 RETURN 
 ENDIF 
 USE IN 3 LIB\XM02.DAT ALIAS XM02
 USE IN 4 LIB\DQK.DAT ALIAS DQK
 SELECT DQK
 CLEAR 
 LOCATE FOR DQDH = VAL(M_DQDH)
 IF FOUND()
 SELECT B02
 DELETE FOR DQDH = VAL(M_DQDH) AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 PACK 
 ELSE 
 ENDIF 
 JLS = RECCOUNT() + 1
 APPEND BLANK
 REPLACE DQDH WITH VAL(M_DQDH) , BLX1 WITH BLX1_C , BLX2 WITH M_BLX2
 REPLACE XMDH WITH 'dpbz'
 REPLACE SJDW WITH 1
 SELECT XM02
 DO WHILE  .NOT. EOF()
 XMDH_C = XMDH
 SELECT B02
 APPEND BLANK
 REPLACE DQDH WITH VAL(M_DQDH) , XMDH WITH XMDH_C , BLX1 WITH BLX1_C , BLX2 WITH M_BLX2 ,  ;
      SJDW WITH 3
 SELECT XM02
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 SELECT SBTMP_C
 SCAN FOR SUBSTR(SBDH,2,2) = M_DQDH AND BLX1 = BLX1_LB
 WAIT WINDOW NOCLEAR NOWAIT  ;
      '正在转换 ' + ALLTRIM(XMDH) + ' 科目  ' + BLX1_LB + '表数据'
 SELECT B02
 LOCATE FOR  ;
      XMDH = SBTMP_C.XMDH AND DQDH = VAL(M_DQDH) AND BLX1 = BLX1_C AND BLX2 = M_BLX2
 REPLACE DA1 WITH SBTMP_C.DA1 , DA2 WITH SBTMP_C.DA2
 SELECT SBTMP_C
 ENDSCAN 
  MESSAGEBOX(MONTH_A - '月份' - M_DQDH - '地区读入' - SYBLX - '损益表完毕！',64,'完成信息提示')
 CLOSE DATABASES 
ENDPROC
*------*