bg.prg

本工资管理系统由foxpro编写,可在VF下运行

set talk off
set sysmenu off
set stat off
 define window tybg from 3,4 to 21,76 shadow colo scheme 7
 activate window tybg
 move window tybg cent
 do while .t.
 set color to w/gr
 @3,8,14,66 box ''
 set color to w+/bg
 @2,6,13,64 box ''
 @5,22 say '安化职业中专办公自动化专业'
 @7,26 say '通用表格输出程序'
 @9,26 say '2000.3.18 吴启武'
filename='.dbf                 '
 @11,23 say '请输入数据库文件名:' get filename
     read
     if file(filename).or.file(allt(filename)+'.dbf')
        use &filename 
        random=sys(3)
        copy to &random stru exte
        use &random
        exit  
     else
        clear
        k='y'
        set color to w+/n
        @7,16,11,58 box ''
        @8,22 say '无此文件,或文件含有备注型字段!'
        @9,24 say '您还要继续吗?[Y/N]' get k valid k$'yYnN'
        read
          if k$'yY'
             set colo to 
             clear
             loop
          else
             set color to
             clear
             rele wind tybg
             clear 
             return
             
          endif
    endif
  enddo
  set color to 
  clear
  dime name_field(recc(),2),bg(3,11)
  bg(1,1)='┌'
  bg(1,2)='└'
  bg(1,3)='┐'
  bg(1,4)='┘'
  bg(1,5)='─'
  bg(1,6)='├'
  bg(1,7)='┤'
  bg(1,8)='│'
  bg(1,9)='┼'
  bg(1,10)='┴'
  bg(1,11)='┬'
  
  bg(2,1)='┏'
  bg(2,2)='┗'
  bg(2,3)='┓'
  bg(2,4)='┛'
  bg(2,5)='━'
  bg(2,6)='┠'
  bg(2,7)='┨'
  bg(2,8)='┃'
  bg(2,9)='┼'
  bg(2,10)='┷'
  bg(2,11)='┯'
  
  bg(3,1)='┏'
  bg(3,2)='┗'
  bg(3,3)='┓'
  bg(3,4)='┛'
  bg(3,5)='━'
  bg(3,6)='┣'
  bg(3,7)='┫'
  bg(3,8)='┃'
  bg(3,9)='╋'
  bg(3,10)='┻'
  bg(3,11)='┳'
  
  set color to g+/3
  @3,10,10,52 box ''
  @5,14 say '┌┬┐         ┏┯┓         ┏┳┓'
  @6,14 say '├┼┤         ┠┼┨         ┣╋┫'
  @7,14 say '└┴┘         ┗┷┛         ┗┻┛'
  @8,13 say '1.全细线       2.外粗里细      3.全粗'
  k='1'
  @10,16 say '请选择表格线型(1/2/3)[1]:' get k valid k$'123'
  read
  k=val(k)
     a=bg(k,1)
     b=bg(k,8)
     c=bg(k,6)
     d=bg(k,2)
     e=bg(k,8)
 for i=1 to recc()
     fieldsub=trim(field_name)
     name_field(i,1)=len(fieldsub)
     name_field(i,2)=field_len
       if name_field(i,1)>name_field(i,2)
          n=int(name_field(i,1)/2)
          b=b+fieldsub+iif(k=2,bg(1,8),bg(k,8))
       else
          n=int(name_field(i,2)/2)
          b=b+fieldsub+space(name_field(i,2)-name_field(i,1))+iif(k=2,bg(1,8),bg(k,8))
       endif
     a=a+repl(bg(k,5),n)+bg(k,11)
     c=c+repl(iif(k=2,bg(1,5),bg(k,5)),n)+bg(k,9)
     d=d+repl(bg(k,5),n)+bg(k,10)
       skip
 next i
     a=substr(a,1,len(a)-2)+bg(k,3)
     c=substr(c,1,len(c)-2)+bg(k,7)
     d=substr(d,1,len(c)-2)+bg(k,4)
 use &filename
 ch='s'
 set color to n/g
 clear
 set color to 
 @6,5 clea to 10,72
 @7,28 say '系统已作好准备 !'
 @9,2 say '您是要将结果输出到屏幕(S),打印机(P),还是保存到文件(F)[默认为S]:' get ch valid ch$'SsPpFf'
     read
     if ch$'Pp'
     @11,16 say '请连接打印机,装好打印纸,按任意键继续...'
     wait ''
     set device to print
     set print on
     else
     if ch$'Ff'
     f='               '
     @11,16 say '请输入文件名(可带盘符和路径)>' get f
     read
     set device to print
     set print on
     set print to &f
     endif
     endif
   clear
   wait '正在输出文件,请稍候...' window time 0.5
   ?a
   ?subs(b,1,len(b)-2)+iif(k=2,bg(2,8),bg(k,8))
     for i=1 to recc()
         ?c
         for j=1 to fcount()
           y=field(j)
           x=&y
           z=type("x")
         do case
            case z='N'
            records=str(x,name_field(j,2))
            case z='D'
            records=dtoc(x)
            case z='L'
            records=iif(x,'是','否')
            case z='C'.or.z='M'
            records=x
         endcase
      if name_field(j,1)>name_field(j,2)
         e=e+records+space(name_field(j,1)-len(records))+iif(k=2,bg(1,8),bg(k,8))
      else
         e=e+records+iif(k=2,bg(1,8),bg(k,8))
      endif
   next j
 ?substr(e,1,len(e)-2)+iif(k=2,bg(2,8),bg(k,8))
 skip
 e=bg(k,8)
 next i
 ?d
 ?
 ?'文件输出完毕,如果您不满意输出结果,请您调整库结构,如删除备注型字段等       '
 ?'                   然后再试试.谢谢使用!'
 wait ''
 set color to 
 set device to screen
 set talk on
 set print off
 set sysmenu on
 close data
 delete file &random
 clea
 deactivate window tybg
 release window tybg
 return