visualfoxpro企业会计电算化实例

*********************************************
*****   凭证查询             查询.prg    *****
*********************************************
CLEAR
close all
set talk off	
@ 0,0 say space(33)+'财  务  查  询'+space(32) color rgb(255,0,0)
	DEFINE WINDOW test1 FROM 1, 1 TO 12, 32 ;
			TITLE " 类别选择 "	 double  close
	ACTIVATE WINDOW test1
	DEFINE WINDOW test2 ;
			FROM 1, 32 TO 12, 98 ;
			TITLE " 明细或文件选择 "  double close 
    ACTIVATE WINDOW test2
			               
	DEFINE WINDOW test3 ;
			FROM 12, 0 TO 26, 98 ;
			TITLE " 科目明细或凭证浏览 " close
	ACTIVATE WINDOW test3

store 1 to k
store 1 to kk

do while .t.
  ACTIVATE WINDOW test1
  clear
  @ 0.5,6 get k func '*vt 科目及其明细;科目各月合计;转帐记帐凭证;收付记帐凭证;单查转帐凭证;单查收付凭证' size 1.2,20,0.1
  read cycle
  do rk
  ACTIVATE WINDOW test2
  dime b(100)
  store ' ' to b
  do case
    case k=1
      do kmjqmx
      return
    case k=2
      do kmgyhj
      return
    case k=3
      n=adir(a,'zz0*.dbf')     &&10年将0换1，20年将1换2，以次例推
    case k=4
      n=adir(a,'sf0*.dbf')
  endcase
  if n=0
     wait window '未有此类文件' timeout 5
     clear window all
     return
  endif   
  dime b(n),c(n)
  for i=1 to n
    if len(a(i,1))=10
      b(i)=a(i,1)+'    '+dtoc(a(i,3))+'  '+a(i,4)+'  '+a(i,5)
      c(i)=10    
    else
      b(i)=a(i,1)+'   '+dtoc(a(i,3))+'  '+a(i,4)+'  '+a(i,5)
      c(i)=12
    endif  
  next  
  @ 0,1 get kk from b func '&t ' size 8,45        
  read cycle
  do rk   
	DEFINE WINDOW test3 ;
			FROM 12, 0 TO 28,98 ;
			TITLE " 凭证浏览 " close
  ACTIVATE WINDOW test3
*  ? (substr(a(kk,1),1,iif(len(a(kk,1))=10,6,8)))
* wait
  use (a(kk,1)) order tag (substr(a(kk,1),1,iif(len(a(kk,1))=10,6,8)))

  if c(kk)=10
    sum 金额合计 to jehj_m
    store '金额合计:'+str(jehj_m,10,2) to w
    wait window w 
  else
    sum 借方 to jfhj_m
    sum 贷方 to dfhj_m
    store '借方合计:'+str(jfhj_m,10,2)+'  贷方合计:'+str(dfhj_m,10,2) to w
    wait window w   
  endif
  brow in window test3 noappend noedit nodelete noclear
  do rk

enddo
return


proc kmjqmx                && 科目及其明细
dime a(200),b(85),mx1(5000),mx(1000,12)
store 0 to a
store ' ' to b
use zk85
copy to array zza
for i=1 to recc()
  b(i)=zza(i,2)
next  
store 1 to h
store 1 to m

do while .t.
DEFINE WINDOW test1 FROM 1, 1 TO 12, 32 ;
			TITLE " 科目选择 "+'  Esc 反回主目录 ' double  close
ACTIVATE WINDOW test1
@ 0,0 get h from b func '&t ' size 8,29
read cycle
do rkk
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 28, 98 ;
			TITLE " 细目: "+zza(h,2)+'     Ctrl_End退出' close
  
    ACTIVATE WINDOW test3
    brow in window test3 noappend noedit nodelete noclear
    do rk
  else
    wait window  '未建此帐'  
  endif  
endif
if zza(h,5)='选用明细'
  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  
      ACTIVATE WINDOW test2
      @ 0,0 get m from mx1 func '&t' size 8,47 
      read
      do rk
	  DEFINE WINDOW test3 ;
			FROM 12, 1 TO 28, 98 ;
			TITLE ' 细目:  '+mx(m,1)+'     Ctrl_End退出'  close 
      ACTIVATE WINDOW test3
      if file(mx(m,2)+'.dbf')
        use &mx(m,2)
        brow in window test3 title ' 细目:'+mx(m,1)+'     Ctrl_End退出';
         noedit noappend nodelete noclear color scheme 1
        do rk
      else
        wait window '未建此帐'
      endif    
    endif
  else
    wait window '未建此帐'
  endif    
endif  
if zza(h,5)='暂不使用'
    wait window '暂不使用本科目'
*    exit
endif    
enddo   
WAIT WINDOW 'Press a key'
clear WINDOW test1, test2,test3
CLEAR
return

proc kmgyhj                && 科目各月合计
dime a(200),b(85),mx1(5000),mx(1000,12)
store 0 to a
store ' ' to b
use zk85
copy to array zza
store 0 to k
for i=1 to recc()
  if zza(i,6)<>' '
    k=k+1
    b(k)=zza(i,2)
  endif  
next  
store 1 to h
do while .t.
  DEFINE WINDOW test1 FROM 1, 1 TO 12, 32 ;
			TITLE " 科目选择 "	foot ' Esc 反回主目录 ' double  close
  ACTIVATE WINDOW test1
  @ 0,0 get h from b func '&t ' size 8,29
  read cycle
  do rkk
  do rk
  if zza(h,5)='选用科目'.or.zza(h,5)='选用明细'
    for i=1 to 85
      if b(h)=zza(i,2)
        if file(zza(i,6)+'.dbf')
          use &zza(i,6)
          ACTIVATE WINDOW test2
          clear
          DEFINE WINDOW test3 ;
	  		FROM 12, 1 TO 28, 98;
			TITLE " 科目: "+zza(i,2)+'  各月合计总页  ' close
  
          ACTIVATE WINDOW test3
          brow in window test3 noappend noedit nodelete noclear
          do rk
        else
          wait window  '未建此帐'  
        endif
      endif    
    next
  else
    wait window '暂不使用本科目'
  endif  
enddo   
WAIT WINDOW 'Press a key'
clear WINDOW test1, test2,test3
CLEAR
return


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

proc rkk          && 键控过程
if readkey()=268.or.readkey()=12   && Esc
  close all
  close data
  deac window all
  clear all
   do 查询
endif  
return