+

visualfoxpro企业会计电算化实例

*************************************************
**            明细数据表整理.PRG               **
*************************************************
CLOSE DATA                                       && 关闭数据库
CLEAR                                            && 清工作台面或自定义窗口
SET DATE ANSI                                    && 设置日期格式为yy.mm.dd
SET CENT ON                                      && 设置世纪格式为yyyy
SET ESCAPE OFF                                   && Esc键失效
DECLARE zza(300,10)                              && 定维数组ZZA,总帐数组
PUBLIC a(300),b(85,5),b1(85),zka(85,7)           && 定维公共数组
STORE 0 TO a                                     && 初始化数组
SELECT 3                                         && 选择工作区
USE 科目总控!zk85                                && 打开表‘ZK85’（总控85,内含85个科目）
COPY TO ARRAY zka                                && 复制到数组zka
COPY TO ARRAY b                                  && 复制到数组b1
FOR i=1 TO 85                                    && 循环
	b1(i)=b(i,2)                                 && 把科目名称赋值给数组b
NEXT                                             && 下一个FOR循环
PUBL k,s,h,BEGIN,the_end                         && 定义公共变量
STORE 0 TO k,s,h                                 && 初始化变量
DO FORM 表单2 NAME 记账开始结束时间 LINK         && 执行表单
READ EVENTS                                      && 激活事件
DEFI WINDOW zwj FROM 0,0 TO 26,110  TITLE "选择科目 进行明细数据表整理" ZOOM  MINIMIZE FLOAT DOUB  CLOSE
ACTI WINDOW zwj                                  && 激活转账借方窗口，复选科目
STORE 0 TO a                                     && 借方科目复选框记录选中数组清零
FOR i=1 TO 21                                    && 循环
	IF b(i,5)='选用明细'                         && 如果选用与否为暂不使用
		@ i-1,0 GET a(i) FUNC "*RN "+b1(i)       && 列出复选框，禁止选用
	ELSE                                         && 否则
		@ i-1,0 GET a(i) FUNC "*RN "+b1(i)  DISA && 列出复选框
	ENDIF
NEXT                                             && 下一个 FOR 循环
FOR i=22 TO 42                                   && 循环
	IF b(i,5)='选用明细'                         && 如果选用与否为暂不使用
		@ i-22,22 GET a(i) FUNC "*RN "+b1(i)     && 列出复选框，禁止选用
	ELSE                                         && 否则
		@ i-22,22 GET a(i) FUNC "*RN "+b1(i)DISA && 列出复选框
	ENDIF
NEXT                                             && 下一个 FOR 循环
FOR i=43 TO 62                                   && 循环
	IF b(i,5)='选用明细'                         && 如果选用与否为暂不使用
		@ i-43,44 GET a(i) FUNC "*RN "+b1(i)     && 列出复选框，禁止选用
	ELSE                                         && 否则
		@ i-43,44 GET a(i) FUNC "*RN "+b1(i)DISA && 列出复选框
	ENDIF
NEXT                                             && 下一个 FOR 循环
FOR i=63 TO 85                                   && 循环
	IF b(i,5)='选用明细'                         && 如果选用与否为暂不使用
		@ i-63,66 GET a(i) FUNC "*RN "+b1(i)     && 列出复选框，禁止选用
	ELSE                                         && 否则
		@ i-63,66 GET a(i) FUNC "*RN "+b1(i)DISA && 列出复选框
	ENDIF
NEXT                                             && 下一个 FOR 循环
@ 22,5 GET kk DEFA 1 FUNC '*th 确认;取消' SIZE 2,4,4     && 命令按钮
READ CYCLE                                       && 激活对象
IF kk=2                                          && 如果选择了取消
	CLEAR ALL                                    && 释放变量、窗口，关闭表
	CANCEL                                       && 终止程序的执行
ENDIF
DEAC WINDOW zwj                                  && 挂起转账借方复选科目窗口

STORE 0 TO m,m1                                  && 初始化变量
FOR i=1 TO 85                                    && 循环
	IF a(i)=1                                    && 如果复选科目时选中
		m=i                                      && 记下选中科目的记录号
		m1=m1+1                                  && 选中个数
	ENDIF
NEXT                                             && 下一个 FOR 循环
IF m1>1                                          && 如果选择了不只一个科目
	WAIT WINDOW '选择了不只一个科目，停止处理'   &&
	CLEAR ALL                                    && 释放变量、窗口，关闭表
	CANCEL                                       && 终止程序的执行
ENDIF
* 处理明细
SELECT 0                                         && 激活工作区
USE b(m,4)                                       && 打开表，明细联系表
COPY TO ARRAY mx                                 && 复制到数组
STORE RECC() TO rec                              && 记下记录个数
m1=0                                             && 变量清零
FOR i=1 TO rec-1                                 && 循环
	SELECT 0                                     && 激活工作区
	USE &mx(i,2)                                 && 打开表，明细实体表
	GOTO BOTTOM                                  && 指针指向末记录
	IF 日期>the_end.OR.余额#0                    && 如果记账日期在过账之后或余额不等于零
		m1=m1+1                                  && 计数器加 1
		STORE 'mx'+ALLTRIM(STR(VAL(RIGHT(b(m,3),6))+m1,6,0)) TO xxmkm  && 新细目表名
		STORE 'mj'+ALLTRIM(STR(VAL(RIGHT(b(m,3),6))+m1,6,0)) TO xyhjk  && 新月合计表名
		? xxmkm,xyhjk                            && 输出在屏幕上
		USE                                      && 关闭表
		SET SAFETY OFF                           && 关闭安全提示窗口
		IF  (mx(i,2)+'.DBF')#(xxmkm+'.DBF')      && 如果表名不相等
			COPY FILE (mx(i,2)+'.DBF') TO (xxmkm+'.DBF')  && 复制文件
			COPY FILE (mx(i,3)+'.DBF') TO (xyhjk+'.DBF')  && 复制文件
		ENDIF
		SELECT &b(m,4)                           && 激活明细联系表工作区
		GOTO m1                                  && 移动指针
		REPLACE 明细名称 WITH mx(i,1)            && 替换字段，下同
		REPLACE 明细库名 WITH xxmkm              &&
		REPLACE 月合计库 WITH xyhjk	             &&
	ELSE                                         && 否则（记账日期不在过账之后且余额等于零）
		USE                                      && 关闭表
		DELETE FILE (mx(i,2)+'.DBF')             && 删除表，下同
		DELETE FILE (mx(i,3)+'.DBF') 		     &&
	ENDIF
NEXT                                             && 下一个FOR循环
SELECT &b(m,4)                                   && 激活明细联系表工作区
DELETE FOR RECNO()>m1.AND.RECNO()<rec            && 做删除标记
PACK                                             && 彻底删除
BROWSE                                           && 浏览
USE                                              && 关闭表
SET SAFETY ON                                    && 打开安全提示窗口
RETURN                                           && 程序结束