visualfoxpro企业会计电算化实例

*********************************************
*****   过帐子系统         过帐.prg     *****
*********************************************
CLEAR
set date ansi
set century on
set talk off	
close all
@ 0,0 say space(34)+'财  务  过  帐'+space(33) color rgb(255,0,0)
	DEFINE WINDOW test1 FROM 1, 1 TO 12, 30 ;
			TITLE " 科目选择 "	foot ' Ctrl-End 退出 ' double close 
	ACTIVATE WINDOW test1
	DEFINE WINDOW test2 ;
			FROM 1, 30 TO 12, 98 ;
			TITLE " 明细选择 "  double close
    ACTIVATE WINDOW test2
			               
	DEFINE WINDOW test3 ;
			FROM 12, 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),mx1(1000),mx(1000,12)
store 0 to a
store ' ' to b
use zk85
store recc() to n85
copy to array zza
use
for i=1 to n85
  b(i)=zza(i,2)
? b(i)
next  

store 1 to h
do while .t.
  ACTIVATE WINDOW test1

  @ 0,0 get h from b(1) func '&t ' size 8,28
  read cycle
  do rk
if zza(h,5)='选用科目'
  if file(zza(h,3)+'.dbf')
    use &zza(h,3)
    ACTIVATE WINDOW test2
    clear
    DEFINE WINDOW test3 ;
			FROM 12, 1 TO 26, 98 ;
			TITLE " 细目: "+zza(h,2) close
    ACTIVATE WINDOW test3
    for i=1 to recc()-1
      goto i
      delete
    next  
        pack
        goto top
        replace 日期 with date()
        replace 日期 with  {^2001-12-26} &&{^-12-26} &&CTOD(STR(YEAR(DATE()-1))+".12.26")  
        replace 摘要 with '上年结转'
        replace 借方 with 0.00
        replace 贷方 with 0.00

    brow in window test3 
        copy to array a
        use zza(h,6)
        set safe off
        zap
        set safe on
        append from array a
        DEFINE WINDOW test3 ;
			FROM 12, 1 TO 26, 98 ;
			TITLE " 月合计: "+zza(h,2)+zza(h,6) +' 总页 ' close
        ACTIVATE WINDOW test3
        brow
        do rk   
  else
    wait window  '未建此帐'  
  endif  
endif

if zza(h,5)='选用明细'  
  if file((zza(h,6))+'.dbf')
      use &zza(h,6)
    else
      copy file (zza(h,3))+'.dbf' to (zza(h,6))+'.dbf'
  endif    
    ACTIVATE WINDOW test2
    clear
    DEFINE WINDOW test3 ;
			FROM 12, 1 TO 26, 98 ;
			TITLE ' '+zza(h,2)+'科目 总页 ' close
    ACTIVATE WINDOW test3
    for i=1 to recc()-1
      goto i
      delete
    next  
        pack
        goto top
        if recc()=0
          append blank
        endif  
        replace 日期 with date()
        replace 日期 with {^2001-12-26}&&CTOD(STR(YEAR(DATE()-1))+".12.26")   && {^2001-12-26} &&.12.26}
        replace 摘要 with '上年结转'
*        replace 借方 with 0.00
*        replace 贷方 with 0.00
    brow in window test3 
  if file(zza(h,4)+'.dbf')
    use &zza(h,4)
    copy to array mx
    if recc()>1
      dime mx1(recc())
      for i=1 to recc()
        mx1(i)=mx(i,1)+mx(i,2)
      next  
      store 1 to m
      store recc() to n
      for u=1 to n
        ACTIVATE WINDOW test2
        @ 0,0 get m from mx1 func '&t' size 8,47 
        read
        do rk
	    DEFINE WINDOW test3 ;
			FROM 12, 1 TO 26, 98 ;
			TITLE ' 细目:  '+mx(m,1) close 
        ACTIVATE WINDOW test3
        if file(mx(m,2)+'.dbf')
          use &mx(m,2)
          if recc()>=2
            for i=1 to recc()-1
              goto i
              delete
            next  
            pack
          else
            if recc()=0
              append blank
            endif
          endif
          goto top  
          replace 日期 with date()
          replace 日期 with {^2001-12-26}&&CTOD(STR(YEAR(DATE()-1))+".12.26")   && {^{^2001-12-26} &&.12.26}
          replace 摘要 with '上年结转'
          replace 借方 with 0.00
          replace 贷方 with 0.00
          brow in window test3 title ' 细目:'+mx(m,1)             
        copy to array a
        if file(mx(m,3)+'.dbf')   
            use &mx(m,3)
          else
            copy structure to &mx(m,3)
            use &mx(m,3)
        endif      
        set safe off
        zap
        set safe on
        append from array a
        DEFINE WINDOW test3 ;
			FROM 12, 1 TO 26, 98 ;
			TITLE " 月合计: "+mx(m,1)+mx(m,3) +' 总页 ' close
        ACTIVATE WINDOW test3
        brow
        do rk   
        else
          wait window '未建此帐'
          if mx(m,1)='创建或增添新明细              '
            exit
          endif  
        endif    
      next  
      exit
    endif
  else
    wait window '未建此帐'
  endif    
endif  
if zza(h,5)='暂不使用'
    wait window '暂不使用此科目 未建此帐'
endif    
   
enddo   
WAIT WINDOW 'Press a key'
RELEASE WINDOW test1, test2,test3
CLEAR
return

proc rk   && 键控过程
if readkey()=270
  close all
  deac window all
  clear all
  cancel
endif  
return