@ 10,1 say 'Enter field name .......' get fld_name picture '@! AXXXXXXXXX'
@ 10,col()+2 say '(<F6> to change last)'
fld_type := 'C'
@ 11,1 say 'Field type (C/N/L/M/D) .' get fld_type picture '@! A' valid fld_type$'CNLMDR'
@ 11,col()+2 say '(R/epeat last)'
SET KEY -5 to modlast
READ
SET KEY -5 to
IF lAbort .or. empty(fld_name)
RETURN
ENDIF
LOCATE FOR fld_name==field_name
IF found()
@ 24,0 say chr(7)+'Field name already exists as field #'+str(recno(),3)+'. Press any key...'
inkey(30)
@ 24,0
LOOP
ENDIF
fld_dec := 0
IF fld_type='M'
fld_len := 10
ELSEIF fld_type='D'
fld_len := 8
ELSEIF fld_type='L'
fld_len := 1
ELSEIF fld_type='R'
GO BOTTOM
fld_type := field_type
fld_len := field_len
fld_dec := field_dec
@ 12,1 say 'REPEATING:'
@ 12,col()+2 say fld_type
@ 12,col()+1 say fld_len
@ 12,col()+1 say fld_dec
ELSE
fld_len := 0
@ 12,1 say 'Field length ...........' get fld_len picture '999'
IF fld_type='N'
@ 13,1 say 'Field decimals .........' get fld_dec picture '999'
ENDIF
READ
IF lAbort
RETURN
ENDIF
ENDIF
yes := .y.
@ 14,1 say 'Accept (Y/N)?' get yes picture 'Y'
READ
IF yes
EXIT
ENDIF
ENDWHILE
APPEND BLANK
REPLACE field_name with fld_name,field_type with fld_type,field_len with fld_len,field_dec with fld_dec
lChanged := .y.
IF new_dbf
USE
CREATE (cDBFName) from \bvdbase
USE
USE \bvdbase excl
EXIT
ENDIF
ENDWHILE
new_dbf := .n.
ENDPROCEDURE
***** Check FOR changes and make 'em
PROCEDURE chk_chg
IF !lChanged
RETURN
ENDIF
lChanged := .n.
@ 3,0 to 23,79 double
SET COLOR to i*
@ 11,11 say '* * * C H A N G E I M P L E M E N T A T I O N * * *'
IF lUseColor
SET COLOR to bg,b/w
ELSE
SET COLOR to
ENDIF
USE
CREATE bvtemp from \bvdbase
APPEND FROM (cDBFName)
USE
ERASE (cDBFName)
RENAME bvtemp.dbf to (cDBFName)
IF file('bvtemp.dbt')
b := substr(cDBFName,1,len(cDBFName)-1)+'t'
ERASE (b)
RENAME bvtemp.dbt to (b)
ENDIF
fShare(cDBFName)
ERASE \bvdbase.dbf
COPY stru exte to \bvdbase
USE \bvdbase excl
@ 11,11 say space(64)
ENDPROCEDURE
*****DELETE A FIELD
PROCEDURE dbf_b
rec := 0
@ 6,1 say 'Field # to delete ...' get rec picture '999'
READ
IF lAbort
RETURN
ENDIF
IF rec<1 .or. rec>reccount()
@ 24,0 say chr(7)+'Invalid field #. Press any key to continue...'
inkey(30)
@ 24,0
RETURN
ENDIF
GO rec
@ 8,1 say field_name
@ 8,col()+2 say field_type
@ 8,col()+2 say field_len
@ 8,col()+2 say field_dec
yes := .n.
@ 10,1 say 'Delete this field (Y/N)?' get yes picture 'Y'
READ
IF yes .and. !lAbort
DELETE
@ 24,0 say chr(7)+'Packing...'
PACK
@ 24,0
lChanged := .y.
ENDIF
ENDPROCEDURE
***** CHANGE FIELDS
PROCEDURE dbf_c
rec := 0
@ 6,1 say 'Starting field #' get rec picture '999'
READ
IF lAbort
RETURN
ENDIF
@ 6,1 clear to 6,70
IF rec<1 .or. rec>reccount()
@ 24,0 say chr(7)+'Field # out of range. Press any key to continue...'
inkey(30)
@ 24,0
RETURN
ENDIF
GO rec
WHILE LOOPING
@ 6,1 say 'Field name ........' get field_name picture '@!'
@ 7,1 say 'Type (C/L/N/D/M) ..' get field_type picture '@! A' valid field_type$'CLNDM'
@ 8,1 say 'Length ............' get field_len valid (field_type='L'.and.field_len=1).or.(field_type='M'.and.field_len=10).or.(field_type='D'.and.field_len=8).or.field_type$'NC'
@ 9,1 say 'Decimals ..........' get field_dec
READ
IF recno()<reccount() .and. !lAbort
nxt := .y.
@ 11,1 say 'Next field (Y/N)?' get nxt picture 'Y'
READ
IF nxt
SKIP
LOOP
ENDIF
ENDIF
lChanged := .y.
RETURN
ENDWHILE
ENDPROCEDURE
***** DISPLAY STRUCTURE
PROCEDURE dbf_d
nLineCtr := 6
start_no := 1
@ 24,0 say 'Starting field # to display:' get start_no picture '999'
@ 24,col()+1 say '(0=reverse display)'
READ
@ 24,0
IF start_no<0 .or. start_no>reccount()
@ 24,0 say 'Invalid field #.'
inkey(5)
@ 24,0
RETURN
ENDIF
IF start_no=0
rev_order := .y.
GO BOTTOM
ELSE
rev_order := .n.
GO start_no
ENDIF
WHILE !(eof() .or. (bof() .and. rev_order))
@ 6,1 clear to 22,78
WHILE !(eof() .or. (rev_order .and. bof())) .and. nLineCtr<=20
IF rev_order .and. nLineCtr=6 .and. reccount()=recno()