bcl93.prg

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

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


 SET TALK OFF
 SET CONSOLE OFF
 SET EXACT ON
 SET SAFETY OFF
 IF 1 = 0
 SET DEFAULT TO \xbbjs
 MMBZ4 = '4'
 NIAN = '1998'
 YUE = '12'
 ENDIF 
 SET TALK OFF
 DO WHILE .T.
 CLOSE DATABASES 
 M_BH = ' '
 STORE '0' TO M_BLX1 , M_BLX2 , M_BLX11 , M_BLX12 , M_BLX21 , M_BLX22
 STORE '  ' TO M_BH , BBB , QNIAN , QYUE , M_LX
 STORE 0 TO DQ1 , DQ2 , DQ , QBAR , SJKEY
 M_BM = ''
 DO FORM .\src\form\bcl93
 DO CASE 
 CASE QBAR = 1
 DO WWW1
 CASE QBAR = 2
 DO WWW2
 CASE QBAR = 3
 DO WWW3
 CASE QBAR = 0 .OR. QBAR = 4
 RETURN 
 ENDCASE 
 ENDDO 

PROCEDURE WWW1
 DO KEY1
 IF M_BH = '00'
 RETURN 
 ENDIF 
 CL_QNIAN = RIGHT(QNIAN,2)
  IF  !FILE('DAT\B&M_BH&cl_QNIAN&QYUE..DAT')
 WAIT WINDOW '不存在' + QNIAN + '年 ' + QYUE + '月 ' + M_BH + '表'
 RETURN 
 ENDIF 
 Q_QUIT = .F.
 DO ACC_KEY WITH 1
 IF Q_QUIT
 RETURN 
 ENDIF 
  BBB="B&M_BH&cl_QNIAN&QYUE"
  USE DAT\&BBB..DAT IN 0
 DQ1 = INT(VAL(DQ1))
 DQ2 = INT(VAL(DQ2))
 M_BLX11 = ALLTRIM(STR(M_BLX11))
 M_BLX21 = ALLTRIM(STR(M_BLX21))
 M_BLX12 = ALLTRIM(STR(M_BLX12))
 M_BLX22 = ALLTRIM(STR(M_BLX22))
 SELECT (BBB)
 LOCATE FOR DQDH = DQ1 AND BLX1 = M_BLX11 AND BLX2 = M_BLX21
 IF  .NOT. FOUND()
 WAIT WINDOW ALLTRIM(STR(DQ1)) + '表中无此数据!'
 RETURN 
 ENDIF 
 LOCATE FOR DQDH = DQ2 AND BLX1 = M_BLX12 AND BLX2 = M_BLX22
 IF  .NOT. EOF()
 MSGTTL = ''
 MESSGTXT = ALLTRIM(STR(DQ2)) + '地区数据已存在是否复盖!'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 6
 DELETE FOR DQDH = DQ2 AND BLX1 = M_BLX12 AND BLX2 = M_BLX22
 PACK 
 ELSE 
 RETURN 
 ENDIF 
 ENDIF 
 DO YD
ENDPROC
*------
PROCEDURE WWW2
 DO KEY1
 IF M_BH = '00'
 RETURN 
 ENDIF 
 CL_QNIAN = RIGHT(QNIAN,2)
  IF  !FILE('DAT\B&M_BH&cl_QNIAN&QYUE..DAT')
 WAIT WINDOW '不存在' + QNIAN + '年 ' + QYUE + '月 ' + M_BH + '表'
 RETURN 
 ENDIF 
 Q_QUIT = .F.
 DO ACC_KEY WITH 2
 IF Q_QUIT
 RETURN 
 ENDIF 
  BBB="B&M_BH&cl_QNIAN&QYUE"
  USE DAT\&BBB..DAT IN 0
 DQ1 = INT(VAL(DQ1))
 DQ2 = INT(VAL(DQ2))
 M_BLX11 = ALLTRIM(STR(M_BLX11))
 M_BLX21 = ALLTRIM(STR(M_BLX21))
 M_BLX12 = ALLTRIM(STR(M_BLX12))
 M_BLX22 = ALLTRIM(STR(M_BLX22))
 SELECT (BBB)
 LOCATE FOR DQDH = DQ1 AND BLX1 = M_BLX11 AND BLX2 = M_BLX21
 IF  .NOT. FOUND()
 WAIT WINDOW ALLTRIM(STR(DQ1)) + ' 地区表中无此数据!'
 RETURN 
 ENDIF 
 LOCATE FOR DQDH = DQ2 AND BLX1 = M_BLX12 AND BLX2 = M_BLX22
 IF  .NOT. EOF()
 MSGTTL = ''
 MESSGTXT = ALLTRIM(STR(DQ2)) + '地区数据已存在是否复盖?'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 6
 DELETE FOR DQDH = DQ2 AND BLX1 = M_BLX12 AND BLX2 = M_BLX22
 PACK 
 ELSE 
 RETURN 
 ENDIF 
 ENDIF 
 DO CB
ENDPROC
*------
PROCEDURE WWW3
 DO SCHF1
 IF M_BH = '00'
 RETURN 
 ENDIF 
 CL_QNIAN = RIGHT(QNIAN,2)
  IF  !FILE('DAT\B&M_BH&cl_QNIAN&QYUE..DAT')
 WAIT WINDOW '不存在' + QNIAN + '年 ' + QYUE + '月 ' + M_BH + '表'
 RETURN 
 ENDIF 
 DO SCHF2
 DQ1 = INT(VAL(DQ1))
 M_BLX11 = ALLTRIM(STR(M_BLX11))
 M_BLX21 = ALLTRIM(STR(M_BLX21))
  BBB="B&M_BH&cl_QNIAN&QYUE"
  USE DAT\&BBB..DAT IN 0
 SELECT (BBB)
 LOCATE FOR DQDH = DQ1 AND BLX1 = M_BLX11 AND BLX2 = M_BLX21
 IF  .NOT. FOUND()
 WAIT WINDOW ALLTRIM(STR(DQ1)) + ' 地区表中无此数据!'
 RETURN 
 ENDIF 
 MSGTTL = '数据删除!!!'
 MESSGTXT = '数据将被删除无法恢复!!!' + CHR(13) + '   是否继续?'
 IF MESSAGEBOX(MESSGTXT,308,MSGTTL) = 7
 RETURN 
 ENDIF 
 DELETE FOR DQDH = DQ1 AND BLX1 = M_BLX11 AND BLX2 = M_BLX21
 PACK 
 MSGTTL = '数据删除'
 MESSGTXT = '删除成功!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
ENDPROC
*------
PROCEDURE REQI
 QNIAN = INT(VAL(NIAN))
 QYUE = INT(VAL(YUE))
 DO FORM .\src\form\getrq TO QNIAN WITH M_BM
 QYUE = RIGHT(QNIAN,2)
 QNIAN = LEFT(QNIAN,4)
ENDPROC
*------
PROCEDURE KEY1
 DO FORM .\src\form\GONG2
 IF M_BH = '00'
 RETURN 
 ENDIF 
 IF  .NOT. USED('bzl')
 USE IN 0 LIB\BZL.DAT
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = M_BH
 M_BH = BH
 M_BM = BM
 M_LS = LS
 DO CASE 
 CASE LX = .T.
 M_LX = 'T'
 CASE LX = .F.
 M_LX = 'F'
 ENDCASE 
 SELECT BZL
 USE 
 DO REQI
ENDPROC
*------
PROCEDURE ACC_KEY
 PARAMETER NNN
 IF NNN = 1
 ACKSTR = '移动'
 ELSE 
 ACKSTR = '复制'
 ENDIF 
 DO FORM .\src\form\bcl93a WITH  ;
      ACKSTR + '   ' + ALLTRIM(M_BM) + SPACE(5) + QNIAN + ' 年  ' + QYUE + ' 月'
ENDPROC
*------
PROCEDURE SCHF1
 DO FORM .\src\form\GONG2
 IF M_BH = '00'
 RETURN 
 ENDIF 
 IF  .NOT. USED('bzl')
 USE IN 0 LIB\BZL.DAT
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = M_BH
 M_BH = BH
 M_BM = BM
 M_LS = LS
 DO CASE 
 CASE LX = .T.
 M_LX = 'T'
 CASE LX = .F.
 M_LX = 'F'
 ENDCASE 
 USE 
 DO REQI
ENDPROC
*------
PROCEDURE SCHF2
 DO FORM .\src\form\bcl93c WITH M_BM + ' ' + QNIAN + '年' + QYUE + '月'
ENDPROC
*------
PROCEDURE YD
 SELECT (BBB)
 SCAN FOR DQDH = DQ1 AND BLX1 = M_BLX11 AND BLX2 = M_BLX21
 REPLACE DQDH WITH DQ2 , BLX1 WITH M_BLX12 , BLX2 WITH M_BLX22
 ENDSCAN 
 MSGTTL = ''
 MESSGTXT = '移动成功'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
ENDPROC
*------
PROCEDURE CB
 SELECT (BBB)
 COPY TO SSS.tmp STRUCTURE 
 COPY TO SSS.tmp FOR DQDH = DQ1 AND BLX1 = M_BLX11 AND BLX2 = M_BLX21
 USE IN 0 SSS.tmp
 SELECT SSS
 SCAN FOR DQDH = DQ1 AND BLX1 = M_BLX11 AND BLX2 = M_BLX21
 REPLACE DQDH WITH DQ2 , BLX1 WITH M_BLX12 , BLX2 WITH M_BLX22
 ENDSCAN 
 SELECT (BBB)
 APPEND FROM SSS.tmp
 SELECT SSS
 USE 
 DELETE File SSS.tmp
 MSGTTL = ''
 MESSGTXT = ' 数据复制成功'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
ENDPROC
*------*