企业管理

开发平台：
VFP

CRL.PRG：源码内容
							***************************
* .CRL.PRG
***************************
if READZD<4
  ?? chr(7)
  return 
endif 
save screen to PM
PD1 = '          '
set color to w/g
@ 6 , 30 , 8 , 53 box '           '
set color to gr+/bg
PD = 'N'
@ 7 , 31 say '真的增加一列吗(Y/N)?' get PD
read 
restore screen from PM
if PD='Y' or PD='y'
  PD2 = 6
  PD3 = 0
  set color to gr+/g
  @ 8 , 29 clear to 14 , 57
  @ 8 , 39 say '增加一列'
  set color to w+/bg , n/w
  @ 9 , 30 clear to 13 , 56
  @ 10 , 31 say '请输入列名称:' get PD1
  @ 11 , 31 say '请输入列宽度:' get PD2 picture '99' valid PD2>0
  @ 12 , 31 say '输入小数位数:' get PD3 picture '9' valid PD3<PD2-1
  read 
  if len(trim(PD1))=0
    restore screen from PM
    return 
  endif 
  PD1 = trim(ltrim(PD1))
  Y1 = ",./:;'"+'"*?|][}{`~&^$#@!%()<>-_'
  PD = len(Y1)
  Y2 = 1
  do while Y2<=PD
    Y3 = substr(Y1,Y2,1)
    Y4 = at(Y3,PD1)
    if Y4<>0
      set color to gr+/n
      @ 15 , 30 say '列名称中含有非法字符!'+Y3
      I = inkey(5)
      set color to w+/b
      restore screen from PM
      return 
    endif 
    Y2 = Y2+1
  enddo 
  Y2 = substr(PD1,1,1)
  if Y2='1' or Y2='0' or Y2='2' or Y2='3' or Y2='4' or Y2='5' or Y2='6' or;
 Y2='7' or Y2='8' or Y2='9'
    set color to gr+/n
    @ 15 , 30 say '列名称不能以数字开头!'
    I = inkey(5)
    set color to w+/b
    restore screen from PM
    return 
  endif 
  FILE1 = GZBWJ+'.dbf'
  use 
  if file('gzb-k.dbf')
    erase gzb-k.dbf
  endif 
  copy file &file1 to gzb-k.dbf 
  use &gzbwj 
  if file('gzbkk.dbf')
    erase gzbk.dbf
  endif 
  copy to gzbk.dbf structure extended
  use gzbk
  locate all for PD1$FIELD_NAME and len(trim(PD1))=len(trim(FIELD_NAME))
  if  not eof()
    set color to gr+/n
    @ 15 , 30 say '列名称已存在!'
    I = inkey(5)
    set color to w+/b
    use &gzbwj
    restore screen from PM
    return 
  endif 
  go READZD
  copy to gz.%%% rest
  go READZD
  delete rest
  pack 
  append blank
  replace FIELD_NAME with PD1 , FIELD_DEC with PD3 , FIELD_TYPE with 'N';
 , FIELD_LEN with PD2
  append from gz.%%%
  erase gz.%%%
  set color to gr+/bg
  X1 = 8
  X2 = 10
  Y1 = 28
  Y2 = 48
  do box-1
  @ 9 , 30 say '正在处理数据......'
  delete all for FIELD_NAME=' '
  pack 
  use 
  FILE = GZBWJ+'.dbf'
  eras &file
  crea &gzbwj from gzbk
  use &gzbwj
  append from gzb-k.dbf
  use 
  use &gzbwj
  select 2
  use 
  select 1
  if file('gzjg.dbf')
    erase gzjg.dbf
  endif 
  copy to gzjg.dbf structure extended
  select 2
  use gzjg
  select 1
  ZDS = fcount()
  PD = 1
  YFGZ = 0
  SFGZ = 0
  do while PD<=ZDS
    if field(PD)='应发工资'
      YFGZ = PD
    endif 
    if field(PD)='实发工资'
      SFGZ = PD
    endif 
    PD = PD+1
  enddo 
  if YFGZ=0
    @ 10 , 30 say '“应发工资”项目没找到！'
    I = inkey(0)
    return 
  endif 
  if SFGZ=0
    @ 11 , 30 say '“实发工资”项目没找到！'
    I = inkey(0)
    return 
  endif 
  go top
  do while  not eof()
    PD = 5
    JSQ = 0
    do while PD<YFGZ
      PD1 = field(PD)
      jsq=jsq+&pd1 
      PD = PD+1
    enddo 
    PD1 = field(YFGZ)
    repl &pd1 with jsq
    PD = YFGZ+1
    do while PD<SFGZ
      PD1 = field(PD)
      jsq=jsq-&pd1
      PD = PD+1
    enddo 
    PD1 = field(SFGZ)
    repl &pd1 with jsq
    skip 
  enddo 
  restore screen from PM
  set color to n/b
  @ 2 , 12 clear to 22 , 79
  P = 1
  set color to gr/n
  @ 0 , 0 say '挚 诚 奉 献 !'
  @ 0 , 67 say 'ＪＱ财务系统'
  set color to g/n
  @ 0 , 30 say '工资表数据编辑'
  @ 1 , 0 say '==============================================================================='
  ? '   '
  ? '==============================================================================='
  @ 23 , 0 say '==============================================================================='
  set color to b/gr
  set color to w+/b
  ZDS = fcount()
  PD = 1
  YFGZ = 0
  SFGZ = 0
  do while PD<=ZDS
    if field(PD)='应发工资'
      YFGZ = PD
    endif 
    if field(PD)='实发工资'
      SFGZ = PD
    endif 
    PD = PD+1
  enddo 
  if YFGZ=0
    @ 10 , 30 say '“应发工资”项目没找到！'
    I = inkey(0)
    return 
  endif 
  if SFGZ=0
    @ 11 , 30 say '“实发工资”项目没找到！'
    I = inkey(0)
    return 
  endif 
  go bottom
  PD = recno()
  JLS = PD
  PD = PD/19
  PD1 = int(PD)
  YS = PD-PD1
  if YS=0
    YS = PD1
  else 
    YS = PD1+1
  endif 
  go top
  YC = 1
  BS = 0
  YS1 = 1
  @ 2 , 0 say '编号'
  @ 2 , 6 say '姓名'
  do while .t.
    LC = 0
    JSQ = 3
    P = 1
    if YFGZ>7
      PD1 = 7
    else 
      PD1 = YFGZ-1
      P = 0
    endif 
    ZD1 = 3
    ZD2 = PD1
    do while JSQ<=PD1
      RFIELD = field(JSQ)
      @ 2 , 20+LC say field(JSQ)
      @ 4+bs,20+lc say &Rfield  
      JSQ = JSQ+1
      LC = LC+12
    enddo 
    @ 4+BS , 0 say 编号
    @ 4+BS , 6 say 姓名
    if  not eof()
      skip 
      BS = BS+1
    else 
      exit 
    endif 
    if BS=19
      exit 
    endif 
  enddo 
  READZD = ZD1
  READLC = 0
  go top
  set color to w+/b
  BS = 0
  LC = 0
  JSQ = 3
  if YFGZ>7
    PD1 = 7
  else 
    PD1 = YFGZ-1
  endif 
  do while JSQ<=PD1
    RFIELD = field(JSQ)
    @ 4+bs,20+lc say &Rfield  
    JSQ = JSQ+1
    LC = LC+12
  enddo 
  @ 4+BS , 0 say 编号
  @ 4+BS , 6 say 姓名
  PD = 0
  ZY = 0
  set color to gr+/bg
  RFIELD = field(READZD)
  @ 4+bs,20+readlc say &Rfield
else 
  restore screen from PM
endif 
return 

						