actwhb.prg

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

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


 SET TALK OFF
 SET CONSOLE OFF
 SET EXACT ON
 SET COLOR TO 
 SET SAFETY OFF
 CLOSE DATABASES 
 ZWMKZ = 1
 SET COLOR TO W+/B
 DEFINE WINDOW YXL1 FROM 0 , 0 TO 24 , 79
 ACTIVATE WINDOW YXL1
 @ 1 , 0 SAY REPLICATE('─',39)
 @ 21 , 0 SAY REPLICATE('─',39)
 SELECT 1
 @ 22 , 13 SAY 'ACT转换关系维护'
 DO WHILE .T.
 @ 2 , 0 CLEAR TO 20 , 78
 @ 0 , 5 PROMPT '查询'
 @ 0 , 17 PROMPT '修改'
 @ 0 , 29 PROMPT '增加'
 @ 0 , 41 PROMPT '删除'
 @ 0 , 55 PROMPT '退出'
 MENU TO XZ
 DO CASE 
 CASE XZ = 1
 DO CX
 CASE XZ = 2
 DO XG
 CASE XZ = 3
 DO ZJ
 CASE XZ = 4
 DO SC
 CASE XZ = 5
 CLOSE DATABASES 
 EXIT 
 ENDCASE 
 ENDDO 
 RELEASE WINDOW YXL1
 CLOSE DATABASES 
 RETURN 

PROCEDURE cx
 SELECT 1
 USE LIB\ACTZH.DAT
 @ 1 , 0 SAY ''
 IF RECCOUNT() = 0
 @ 10 , 20 SAY ' *********     无转换公式  !       ********'
 RETURN 
 ENDIF 
 @ ROW() + 1 , 5 SAY '序号'
 @ ROW() , 10 SAY '新科目'
 @ ROW() , 20 SAY '旧科目'
 FOR KL = 1 TO RECCOUNT()
 LOCATE FOR XH = KL
 IF ROW() > 19
 @ 21 , 76 SAY '─'
 WAIT ''
 @ 3 , 0 CLEAR TO 20 , 78
 @ 2 , 0 SAY ''
 ENDIF 
 @ ROW() + 1 , 5 SAY XH
 @ ROW() , 10 SAY ALLTRIM(XMDH)
 @ ROW() , 20 SAY ALLTRIM(XMDHM)
 ENDFOR 
 @ 21 , 76 SAY '─'
 WAIT ''
ENDPROC
*------
PROCEDURE XG
 ?? NUMLOCK(.T.)
 @ 3 , 3 SAY '请输入修改序号:'
 DS = 0
 @ 3 , 20 GET DS PICTURE '99'
 READ 
 IF DS = 0
 RETURN 
 ENDIF 
 GS = ''
 SELECT 1
 USE LIB\ACTZH.DAT
 LOCATE FOR XH = DS
 IF  .NOT. EOF()
 @ 8 , 10 SAY '新科目'
 @ 8 , 20 SAY '旧科目'
 @ 10 , 10 GET XMDH
 @ 10 , 20 GET XMDHM
 READ 
 IF READKEY() < 37
 RETURN 
 ENDIF 
 ELSE 
 @ 6 , 6 SAY '无此公式'
 ABCD = INKEY(2)
 ENDIF 
ENDPROC
*------
PROCEDURE ZJ
 SELECT 1
 USE LIB\ACTZH.DAT
 @ 3 , 1 SAY '公式序号:'
 @ 3 , 11 SAY RECCOUNT() + 1
 DS = RECCOUNT() + 1
 APPEND BLANK
 REPLACE XH WITH DS
 @ 8 , 10 SAY '新科目'
 @ 8 , 20 SAY '旧科目'
 @ 10 , 10 GET XMDH
 @ 10 , 20 GET XMDHM
 READ 
ENDPROC
*------
PROCEDURE SC
 ? NUMLOCK(.T.)
 @ 3 , 3 SAY '请输入删除序号:'
 DS = 0
 @ 3 , 25 GET DS PICTURE '99'
 READ 
 IF DS = 0
 RETURN 
 ENDIF 
 GS = ''
 SELECT 1
 USE LIB\ACTZH.DAT
 LOCATE FOR XH = DS
 IF  .NOT. EOF()
 @ 8 , 10 SAY '新科目'
 @ 8 , 20 SAY '旧科目'
 @ 10 , 10 SAY XMDH
 @ 10 , 20 SAY XMDHM
 YY = 'N'
 @ 12 , 5 SAY '确认删除吗?( Y / N )'
 @ 12 , 35 GET YY
 READ 
 IF YY = 'Y' .OR. YY = 'y'
 SELECT 1
 DELETE FOR XH = DS
 PACK 
 SELECT 1
 FOR KL = DS + 1 TO RECCOUNT(1) + 1
 SELECT 1
 LOCATE FOR XH = KL
 REPLACE XH WITH KL - 1
 SELECT 2
 REPLACE XH WITH KL - 1 FOR XH = KL
 ENDFOR 
 ENDIF 
 ELSE 
 @ 6 , 6 SAY '无此公式'
 ABC = INKEY(2)
 ENDIF 
ENDPROC
*------*