www.pudn.com > jq_gongzi.ARJ > 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-_' 
  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 PD7 
      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