+

visualfoxpro企业会计电算化实例

*********************************************
*****   过帐子系统         过帐.prg     *****
*********************************************
CLEAR ALL
SET DATE ANSI
SET CENTURY ON
SET TALK OFF
CLOSE data
PUBLIC BEGIN,the_end
do form 表单2 name 时间表 link
read events
@ 0,0 SAY SPACE(34)+'财  务  过  帐'+SPACE(33) COLOR RGB(255,0,0)
DEFINE WINDOW test3 ;
	FROM 2, 1 TO 26, 98 ;
	TITLE " 财  务  过  帐  " CLOSE
ACTIVATE WINDOW test3
@ 3,10 SAY '警告:过帐之前必须拷贝上年全部数据,如未拷贝即应退出,进行拷贝.' COLOR RGB(255,0,0)
@ 4,27 SAY '如已拷贝则可以过帐.' COLOR RGB(255,0,0)
STORE 1 TO s
@ 7,25 GET s DEFA 1 FUNC '*th 退    出;进行过帐' SIZE 2,8,8
READ
DO rk
IF s=1
	CLEAR ALL
	CANCEL
ENDIF

CLEAR
DIME a(200),b(85),mx(1000,12)
STORE 0 TO a
STORE ' ' TO b
USE zk85
STORE RECC() TO n85
COPY TO ARRAY zza
USE
FOR i=10 TO 10      && 1 to n85
	? zza(i,2)
	if i=32.or.i=42                  && 固定资产及折旧 递延资产
		loop
	endif	
	IF zza(i,5)='选用科目'
		USE &zza(i,3)
		FOR j=1 TO RECC()-1
			GOTO j
			DELETE
		NEXT
		PACK
		GOTO TOP
		REPLACE 日期 WITH THE_END
		REPLACE 凭证号 WITH ' '
		REPLACE 摘要 WITH '上年结转'
		REPLACE 借方 WITH 0.00
		REPLACE 贷方 WITH 0.00
		DEFINE WINDOW test3 FROM 2, 1 TO 26, 98 TITLE " 财务过帐  "+zza(i,2) CLOSE
		ACTIVATE WINDOW test3
		BROW  timeout 1
		USE &zza(i,6)
		FOR j=1 TO RECC()-1
			GOTO j
			DELETE
		NEXT
		PACK
		GOTO TOP
		REPLACE 日期 WITH THE_END
		REPLACE 摘要 WITH '上年结转'
		REPLACE 借方 WITH 0.00
		REPLACE 贷方 WITH 0.00
*		BROW IN WINDOW test3 timeout 1
	endif
	IF zza(i,5)='选用明细'
		USE &zza(i,3)
		FOR j=1 TO RECC()-1
			GOTO j
			DELETE
		NEXT
		PACK
		GOTO TOP
		REPLACE 日期 WITH THE_END
		REPLACE 凭证号 WITH ' '
		REPLACE 摘要 WITH '上年结转'
		REPLACE 借方 WITH 0.00
		REPLACE 贷方 WITH 0.00
		DEFINE WINDOW test3 FROM 2, 1 TO 26, 98 TITLE " 财务过帐  "+zza(i,2) CLOSE
		ACTIVATE WINDOW test3
*		BROW timeout 1
		USE &zza(i,6)
		FOR j=1 TO RECC()-1
			GOTO j
			DELETE
		NEXT
		PACK
		GOTO TOP
		REPLACE 日期 WITH THE_END
		REPLACE 摘要 WITH '上年结转'
		REPLACE 借方 WITH 0.00
		REPLACE 贷方 WITH 0.00
*		BROW  timeout 1
		use zza(i,4)
		copy to array mx
		store recc() to n
		for k=1 to n-1
			USE &mx(k,2)
			FOR j=1 TO RECC()-1
				GOTO j
				DELETE
			NEXT
			PACK
			GOTO TOP
			REPLACE 日期 WITH THE_END
			REPLACE 凭证号 WITH ' '
			REPLACE 摘要 WITH '上年结转'
			REPLACE 借方 WITH 0.00
			REPLACE 贷方 WITH 0.00
			DEFINE WINDOW test3 FROM 2, 1 TO 26, 98 TITLE " 财务过帐  "+zza(i,2)+mx(k,1) CLOSE
			ACTIVATE WINDOW test3
			BROW  timeout 1
			USE &mx(k,3)
			FOR j=1 TO RECC()-1
				GOTO j
				DELETE
			NEXT
			PACK
			GOTO TOP
			REPLACE 日期 WITH THE_END
			REPLACE 摘要 WITH '上年结转'
			REPLACE 借方 WITH 0.00
			REPLACE 贷方 WITH 0.00
*			BROW  timeout 1
		next
	endif
next
CLEAR all
RETURN

	PROC rk   && 键控过程
	IF READKEY()=270
		CLOSE ALL
		CLEAR ALL
		CANCEL
	ENDIF
	RETURN