actzh.prg

来自「使用VFP编写的信用社系统专用会计报表系统,可上报,汇总,打印.是一款优秀的信用」· PRG 代码 · 共 146 行

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


 SET TALK OFF
 SET SAFETY OFF
 SET PROCEDURE TO actzh
 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 WHILE .T.
 ACTSZ = 0
 Q_QUIT = .F.
 DO FORM src\form\actzh
 IF Q_QUIT
 RETURN 
 ENDIF 
 IF ACTSZ = 1
 DO src\prg\ACTWH
 ELSE 
 DO ACTZHP
 ENDIF 
 ENDDO 

PROCEDURE ACTZHP
 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.:A&cl_YEAR&MONTH_A&M_DQDH..DAT")
  WAIT WINDOW "会计报表数据不存在，请拷入&pa.盘"
 ELSE 
 DO ZHSJ
 ENDIF 
 ENDIF 
 WAIT CLEAR
ENDPROC
*------
PROCEDURE ZHSJ
  IF FILE("DAT\B01&cl_YEAR&MONTH_a..DAT") 
  use DAT\B01&cl_YEAR&MONTH_a..DAT
 LOCATE FOR DQDH = VAL(M_DQDH)
 IF FOUND()
 IF MESSAGEBOX('目的数据已存在! 覆盖吗 ? ( Y / N) ',36,'提示') = 7
 USE 
 RETURN 
 ELSE 
 DELETE FOR DQDH = VAL(M_DQDH)
 PACK 
 USE 
 ENDIF 
 ENDIF 
 ELSE 
  do wj with "B01&cl_YEAR&MONTH_a","01"
 ENDIF 
 SELECT 1
 USE lib\ACT1.DAT
 ZAP 
  APPE FROM &PA.:A&cl_yEAR&MONTH_a&M_DQDH..DAT SDF TYPE
 SELECT 2
  USE DAT\B01&cl_YEAR&MONTH_a..DAT ALIA B01
 SELECT 6
 USE lib\actzh.dat
 SELECT 3
 USE LIB\DQK.DAT
 CLEAR 
 LOCATE FOR DQDH = VAL(M_DQDH)
 IF FOUND()
 SELECT B01
 JLS = RECCOUNT() + 1
 APPEND BLANK
 REPLACE DQDH WITH DQK.DQDH
 REPLACE XMDH WITH 'dpbz'
 REPLACE SJDW WITH 1
 SELECT 1
 USE lib\act1.dat
 COPY TO actmp.dat FOR DQDH = DQK.DQDH
 USE actmp.dat ALIAS ACTMP
 SELECT 4
 USE LIB\XM01.DAT
 SCAN 
 WAIT WINDOW NOCLEAR NOWAIT '正在转换 ' + ALLTRIM(XMDH) + ' 科目数据'
 SELECT 6
 LOCATE FOR ALLTRIM(XMDH) = ALLTRIM(XMDH)
 IF FOUND()
 XMDHLS = ALLTRIM(XMDHM)
 ELSE 
 XMDHLS = ALLTRIM(XMDH)
 ENDIF 
 SELECT 1
 LOCATE FOR ALLTRIM(XMDH) == XMDHLS
 SELECT B01
 APPEND BLANK
 REPLACE DQDH WITH DQK.DQDH
 REPLACE DQDH WITH VAL(M_DQDH)
 REPLACE XMDH WITH XM01.XMDH
 FOR AA = 1 TO 6
 BB = ALLTRIM(STR(AA))
  fs=right(a->da&bb,1)
 IF FS > '9'
  repl da&bb with  -(val(a->da&bb)/10+(asc(fs)-112)/100)
 ELSE 
  repl da&bb with val(a->da&bb)/100
 ENDIF 
 ENDFOR 
 REPLACE SJDW WITH 3
 ENDSCAN 
 ENDIF 
 SELECT B01
 DO CASE 
 CASE A.LX == '99'
 LX1 = '1'
 CASE A.LX == '97'
 LX1 = '3'
 CASE VAL(LX) >= 91 AND VAL(LX) <= 94
 LX1 = '2'
 ENDCASE 
 SELECT B01
 REPLACE BLX1 WITH ('1')
 REPLACE BLX2 WITH ('0')
 SELECT 1
 USE lib\act1.dat
 ZAP 
 DELETE File actmp.dat
 CLOSE DATABASES 
ENDPROC
*------*