lr01.prg

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

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


 LSLR = 0
 BCZLCL = 0
 WJJC = 0
 STORE 'LIB\xm' + (M_BH) + '.DAT' TO DATNAME
 STORE 'XM' + (M_BH) TO XMKNAME
 DO OPENWJ WITH DATNAME , WJJC
 IF WJJC = 1
 ?? CHR(7)
 WAIT WINDOW '无项目库'
 RETURN 
 ENDIF 
 STORE 'lib\lrpd.dat' TO DATNAME
 DO OPENWJ WITH DATNAME , WJJC
 IF WJJC = 1
 ?? CHR(7)
 WAIT WINDOW '无lrpd.dat文件'
 RETURN 
 ENDIF 
 DATNAME = 'LIB\blk.DAT'
 DO OPENWJ WITH DATNAME , WJJC
 IF WJJC = 1
 ?? CHR(7)
 WAIT WINDOW '无表栏库'
 RETURN 
 ENDIF 
 DATNAME = 'LIB\bzl.DAT'
 DO OPENWJ WITH DATNAME , WJJC
 IF WJJC = 1
 ?? CHR(7)
 WAIT WINDOW '无表种类库'
 RETURN 
 ENDIF 
 DATNAME = 'DAT\B' + (M_BH) + RIGHT(NIAN,2) + (YUE) + '.DAT'
 BDATNAME = 'b' + (M_BH) + RIGHT(NIAN,2) + (YUE)
 DO OPENWJ WITH DATNAME , WJJC
 IF WJJC = 1
 DO WJSC WITH DATNAME
 SELECT (BDATNAME)
 ENDIF 
 SELECT (BDATNAME)
 GO TOP
  LOCATE FOR blx1="&m_blx1" AND blx2="&m_blx2" AND dqdh=m_dqdh 
 IF EOF()
 DO NRSC WITH BDATNAME , XMKNAME
 ENDIF 
 IF M_BCZL = .T.
 DO WHILE .T.
 SELE1 = 0
 Q_QUIT = .F.
 DO FORM src\form\bcbb
 IF Q_QUIT
 RETURN 
 ENDIF 
 IF SELE1 = 1
 DO BBLR
 ELSE 
 BCZLCL = 1
 DO LR022 WITH BDATNAME , XMKNAME , BCZLCL , M_BCZL
 ENDIF 
 ENDDO 
 ELSE 
 SELECT (BDATNAME)
  INDEX ON XMDH TO DAT\&bdatname 
 USE 
 USE IN 0 (DATNAME)
 DO BBLR
 ENDIF 
 SELECT BLK
 USE 
 SELECT BZL
 USE 
 SELECT (XMKNAME)
 USE 
 SELECT (BDATNAME)
 USE 
 SELECT LRPD
 USE 
 CLOSE DATABASES 
 RETURN 

PROCEDURE BBLR
 IF M_LS > 6 .OR. M_BH = '12' .OR. M_BH = '99'
 DO src\prg\LR022 WITH BDATNAME , XMKNAME , BCZLCL , M_BCZL
 ELSE 
 LSSZ = 0
 SELECT (XMKNAME)
 SELE2 = 0
 Q_QUIT = .F.
 DO FORM .\src\form\lrfs
 IF Q_QUIT
 RETURN 
 ENDIF 
 IF SELE2 = 1
 IF M_BH = '04' .OR. M_BH = '99'
 ?? CHR(7)
 ?? CHR(7)
 SZ = '0'
 MSGTTL = '录入修改'
 MESSGTXT = '建议本表采用列录入方式' + CHR(13) + '是否继续?'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 7
 RETURN 
 ENDIF 
 ENDIF 
 DO LR021
 ELSE 
 DO src\prg\LR022 WITH BDATNAME , XMKNAME , BCZLCL , M_BCZL
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE LR021
 KKK_NIAN = NIAN
 DO CASE 
 CASE M_LS = 1
 DO src\prg\BOX01 WITH BDATNAME , XMKNAME
 CASE M_LS = 2
 DO src\prg\BOX02 WITH BDATNAME , XMKNAME
 CASE M_LS = 3
 DO src\prg\BOX03 WITH BDATNAME , XMKNAME
 CASE M_LS = 4
 DO src\prg\BOX04 WITH BDATNAME , XMKNAME
 CASE M_LS = 6
 DO src\prg\BOX06 WITH BDATNAME , XMKNAME
 ENDCASE 
 DO ZBDP
 RETURN 
ENDPROC
*------
PROCEDURE OPENWJ
 PARAMETER DATNAME , WJJC
 WJJC = 0
 IF FILE(DATNAME)
 IF  .NOT. USED(DATNAME)
 USE IN 0 (DATNAME)
 ENDIF 
 ELSE 
 WJJC = 1
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE wjsc
 PARAMETER DATNAME
 SET SAFETY OFF
 SELECT BLK
 COPY TO tmp\t001 STRUCTURE EXTENDED 
 SELECT 0
 USE tmp\t001
 ZAP 
 SELECT FIELD_NAME , FIELD_TYPE , FIELD_LEN , FIELD_DEC WHERE BH = (M_BH) INTO TABLE  ;
      tmp\tmp FROM blk
 SELECT T001
 APPEND FROM tmp\tmp
 XXXX = LEFT(DATNAME,LEN(DATNAME) - 4)
 XXXXX = SUBSTR(XXXX,AT('\',XXXX))
  create &xxxx from tmp\t001
 USE 
  rename &xxxx..dbf to &xxxx..dat
  use &xxxx..dat
 SELECT TMP
 USE 
 DELETE File tmp\TMP.dbf
 DELETE File tmp\tmp.dbf
 RETURN 
ENDPROC
*------
PROCEDURE NRSC
 PARAMETER BDATNAME , XMKNAME
 SELECT (BDATNAME)
 APPEND BLANK
 REPLACE XMDH WITH 'dpbz' , SJDW WITH 0
  APPEND FROM lib\&xmkname..dat FIELDS xmdh,sjdw
  REPLACE dqdh WITH m_dqdh, blx1 WITH "&m_blx1", blx2 WITH "&m_blx2" FOR DQDH=0
 RETURN 
ENDPROC
*------
PROCEDURE ZBDP
 SELECT (BDATNAME)
 REPLACE SJDW WITH 0 FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND XMDH = 'dpbz'
 SZ = 'N'
 MSGTTL = '录入修改'
 MESSGTXT = '是否对整表打平?'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 6
 DO src\prg\DPCL1
 ENDIF 
 RETURN 
ENDPROC
*------*