*:
*: Modi.prg - Create/Modify data files
*:
*: Copyright (c) 1992 Computer Associates International Inc.
*:
*: Edit Date  By                  Reason
*:---------------------------------------------------------------------------
*:            Dan Luciano         New Program for 2.0
*:---------------------------------------------------------------------------
*:
*: Add this line to chdir to workdir()
*: workdir() will tell us were dbfast was loaded from.  We need to 
*: chdir to the workdir() in case the user has done something in dbfast
*: that cause it to change to a floppy drive.  If the user does something on
*: the floppy drive and then remove the floppy disk when dbfast tries to do
*: a LoadLib() to load the dll used in the DECLARE the system (ie. DOS, 
*: Windows) look for the dll on the current default which is now the floppy.
*; Because the floppy disk has been removed this will cause a system error.
*: This line of code will make sure this does not happen.
*:
//chdir workdir()			// stay in current directory
set cursor to wait
		
DECLARE PFUNCTION GetWindowWord RETURNING INTEGER IN DLL user
declare pfunction GlobalFindAtom returning integer in dll user

declare pfunction GetModuleFileName returning integer in dll kernel 

set procedure to modi
set system font to -1
set exact on
set deleted on
set safety off

on error do CheckErr

store .f. to lNew, lChanged, lAdding, lInserting, lShow, lActiveChanges
store .t. to lWasError
store  '' to sFieldName, sFieldSel, sTheButton, sTheWindow, sRecord
store '0' to sLength, sDecimal
store 'C' to sType
store  0  to nTheMenu, nTheOption, nTheRow, nTheCol, nTheKey, ;
			 nRecSize, nSaveLen, nTotFields, nRec

store HWnd() to hwndModi
hInst = GetWindowWord( hwndModi, -6 )

sAtom = 'MODI_NEW'
if GlobalFindAtom(sAtom)
  lNew = .t.
endif

*:
*: get the directory where we want to build the temporary files
*:
sTempDir = getenv('TEMP')

if empty(sTempDir)
  sModuleName = space(250)
  GetModuleFileName( hInst, @sModuleName, 250 )
  sTempDir = left(sModuleName, rat('\',sModuleName))
endif

nLen = len(sTempDir)
if substr(sTempDir,nLen,1) <> '\'
  sTempDir = sTempDir + '\'
endif

sTempDbf1  = tempfile(1)

sTheFile = ''
if .not. lNew
  sTheFile = dbfmenu( csFODataFiles, csModify + ' ' + csStructure)
  if empty(sTheFile)            && cancel was selected
	quit
  else
	if rat('.',sTheFile) = 0
	  sTheFile = upper(trim(sTheFile)) + '.DBF'
	endif
	use &sTheFile
  endif
endif

copy to &sTempDbf1 struct extended

if .not. lWasError
  quit
endif  

declare arFieldInfo[cnMaxFields + 2]
afill(arFieldInfo,'')

use &sTempDbf1

if .not. lNew
	count all to nTotFields
	if nTotFields = 0
	  beep
	  warning( csFieldCError, csNumFields, 387 )
	  use
	  erase &sTempDbf1
	  quit
	endif

	sum field_len to nRecSize
	goto top

	for i = 2 to nTotFields + 1
	  arFieldInfo[i] = field_name + chr(9) + field_type + chr(9) + ;
		str(field_len,3) + chr(9) + str(field_dec,2)
	  skip
	next i
	goto top
endif

do MakeDialog with wModi,15,57,cnCloseButton + cnCancelButton,.f.

if lNew
  set window title to csCreate + ' ' + csStructure
else
  set window title to csModify + ' ' + csStructure + ;
	' - [' + MakeTitle(sTheFile) + ']'
endif

@ 1, 1 say csName + ':'
CREATE CONTROL EDITBOX 'EB.Name' AT 2,1 SIZE 1,19 SAVE TO sFieldName ;
  valid NameValid(childevent()) on start + exit limit 10

@ 1,21 say csType + ':'
create CONTROL combo 'CB.Type' at 2,21 size 6,8 save to sType ;
  valid UpdateField('TYPE') contents csTypes

@ 1,30 say csLength + ':'
create CONTROL editbox 'EB.Length'  at 2,30 size 1,7 save to sLength ;
  valid UpdateField('LENGTH') on start + exit limit 3

@ 1,38 say csDecimals + ':'
create CONTROL editbox 'EB.Decimal' at 2,38 size 1,7 save to sDecimal ;
  valid UpdateField('DECIMAL') on start + exit limit 2

set listbox tabs to 20,29,37
set listbox to cnNoSort
create CONTROL listbox 'LB.Modi' at 4,1 size 9,44 save to sRecord ;
	contents @arFieldInfo valid ShowFieldInfo(.t.)

create button bSaveAs at  4,47 size 1,8 plain valid ModiSaveAs()

create button bAdd    at  7,47 size 1,8 plain valid ModiAdd()
create button bInsert at  9,47 size 1,8 plain valid ModiIns()
create button bDelete at 11,47 size 1,8 plain valid ModiDel()

set exit button to bCancel

sRecord = arFieldInfo[2]
if .not. lNew
  ShowFieldInfo(.f.)
endif

select CONTROL 'EB.Name'
select window 'CONSOLE'
set cursor to arrow

show window wModi
set cursor to arrow
set message to ''

if lNew
  ModiAdd()
else
	@ 0,1
  @ 0,1 say csEditField
endif
lActiveChanges = .f.    && reset because of ModiAdd

nAction = 0
do while nAction <> -1
  select window wModi
  @ 14, 0 say csNumFieldsCol + transform(nTotFields,'9999')
  @ 14,29 say csRecSize      + transform(nRecSize,  '99999')
  nEvent = GetEvent()
  nAction = TranslateMEvent(nEvent)
  do ModiAction
enddo

close window wModi

return


*******************
function GetEvent()                       && Get the latest event
*******************
private nTheEvent

  store '' to sTheWindow, sTheButton
  store 0 to nTheMenu, nTheOption, nTheRow, nTheCol, nTheKey

  nTheEvent  = -1
  do while nTheEvent = -1
	nTheEvent = chkevent()
  enddo
  *:
  sTheWindow = window()
  sTheButton = button()
  nTheMenu   = hmenu()
  nTheOption = vmenu()
  nTheRow    = mrow()
  nTheCol    = mcol()
  nTheKey    = lastkey()
return(nTheEvent)


**************************
function TranslateMEvent()
**************************
parameter nTheEvent
private nTheAction

  nTheAction = 0
  do case
	case nTheEvent = eClose
	  nTheAction = aExit

	case nTheEvent = eKybd
	  do case

		case nTheKey = kF1
		  if lNew
			help 'New Structure dialog box' file dbfast.hlp
		  else
			help 'Modify Structure dialog box' file dbfast.hlp
		  endif

		case nTheKey = kEnter
		  nTheAction = aNext

		case nTheKey = kEsc
		  if lAdding .or. lInserting
			if nTotFields = 0
			  nTheAction = aExit
			else
			  nTheAction = aCancel
			endif
		  else
			nTheAction = aExit
		  endif
	  endcase

	case nTheEvent = eButton

	  do case
		case sTheButton = bClose
		  nTheAction = aExit
		  
		case sTheButton = bCancel .or. sTheButton = bDone
		  if lAdding .or. lInserting
			if nTotFields = 0
			  lChanged = .f.
			  nTheAction = aExit
			else
			  nTheAction = aCancel
			endif
		  else
			lChanged = .f.
			nTheAction = aExit
		  endif

	  endcase
  endcase
return(nTheAction)


********************
procedure ModiAction
********************

  do case
	case nAction = aExit
	  ModiClose()

	case nAction = aAdd
	  ModiAdd()

	case nAction = aInsert
	  ModiIns()

	case nAction = aDelete
	  ModiDel()
	  
	case nAction = aNext
	  set message to '' 
	  lValidated =  ChkFldName(sFieldName)        
	  if lValidated 
		lValidated =  ChkFldLen(sLength, left(sType,1)) 
	  endif        
	  if lValidated 
		lValidated = ChkFldDec(sDecimal, sLength, left(sType,1)) 
	  endif              
	  if lValidated
		if nRecSize + val(sLength) <= cnMaxFieldSize-1
		  replace ;
			field_name with upper(sFieldName), ;
			field_len  with val(sLength), ;
			field_dec  with val(sDecimal), ;
			field_type with left(sType,1)
		  commit
		  nRec = recno()
		  lActiveChanges = TRUE
		  if .not. lAdding
			enable button bCancel
			  enable button bSaveAs
			  enable button bClose
			  enable button bAdd
			  enable button bInsert
			enable button bDelete
		  endif

		  if lAdding .or. lInserting
			nRecSize = nRecSize + a->Field_Len
			inc nTotFields
		  else 
			if nTheKey = kEnter
			  sum a->Field_Len to nRecSize 
			endif  
		  endif

		  arFieldInfo[nRec + 1] = upper(sFieldName) + chr(9) + ;
			  left(sType,1) + chr(9) + rtjust(sLength,3) + chr(9) + rtjust(sDecimal,2)

		  replace listbox 'LB.Modi' with arFieldInfo
		  sRecord = arFieldInfo[nRec + 1]
		  update CONTROL 'LB.Modi'
		  enable control 'EB.Length'
		  enable control 'EB.Decimal'

		  if lAdding
			lAdding = .f.
			ModiAdd(.f.)
		  else
			store .f. to lInserting //, lAdding
			  ShowFieldInfo(.f.)
			  @ 0,1
			  @ 0,1 say csEditField
		  endif
		  lChanged = .t.          

		else  // nRecSize
		  beep
		  sMessage =  cesGT3999Bytes
		  set message to sMessage
		  select CONTROL 'EB.Length'
		endif  // nRecSize
	  endif   // lValidated

	case nAction = aCancel
		if reccount() != 1  // This line prevents packing an empty file
		arFieldInfo[recno() + 1] = ''
		  delete
		pack

		  if lAdding
		  sRecord = arFieldInfo[2]
			goto top
		  sFieldName = field_name
			sType = field_type
			sLength = alltrim(str(field_len,3))
		  sDecimal = alltrim(str(field_dec,2))
		
			replace control bDone with bAdd
		endif

		  if lInserting
		  for i = nRec + 1 to nTotFields + 1
			  arFieldInfo[i] = arFieldInfo[i + 1]
		  next i
			arFieldInfo[i] = ''
		  endif
  
		store .f. to lAdding, lInserting
 
		  replace listbox 'LB.Modi' with arFieldInfo
		if .not. lShow
			goto top
		  sRecord = arFieldInfo[2]
			update CONTROL 'LB.Modi'
		  ShowFieldInfo(.f.)
		  endif
	  
		enable button bCancel
		  enable button bSaveAs
		enable button bClose
		enable button bAdd
	  
		  if nTotFields > 0
		  enable button bInsert
			enable button bDelete
		  endif
 
		@ 0,1
		  @ 0,1 say csEditField
		select CONTROL 'EB.Name'
		  endif
  endcase
	
return


************************
function ShowFieldInfo()
************************
parameter lInListBox

  if (lAdding .or. lInserting)
	if empty(sRecord)
	   return(.t.)
	endif
	sHoldRecord = sRecord
	lShow = .t.
	if lInserting
	  goto nRec
	endif
	nAction = aCancel
	do ModiAction
	lShow = .f.
	nRecordNum = ascan(arFieldInfo,sHoldRecord,2)
	sRecord = sHoldRecord
	update CONTROL 'LB.Modi'
  else
	nRecordNum = ascan(arFieldInfo,sRecord,2)
  endif

  if nRecordNum <> 0
	goto nRecordNum - 1
	sFieldName = a->field_name
	sType      = a->field_type
	sLength    = alltrim(str(a->field_len,3))
	sDecimal   = alltrim(str(a->field_dec,2))

	update CONTROL 'EB.Name'
	update CONTROL 'CB.Type'
	update CONTROL 'EB.Length'
	update CONTROL 'EB.Decimal'
  endif

	if sType $ 'MDLP'
		disable control 'EB.Length'
		disable control 'EB.Decimal'
	else
		enable control 'EB.Length'
		enable control 'EB.Decimal'
	endif

  if .not. lInListBox
	  select CONTROL 'EB.Name'
	endif
return(.t.)


********************
function NameValid()
********************
parameter nHowCalled

  if nHowCalled = 1
  else
	  UpdateField('NAME')
  endif

return(.t.)

**********************
function UpdateField()
**********************
parameter sDbfField

  set message to ''
  if .not. empty(trim(dbf()))
	lChanged = .t.
	do case
	  case sDbfField = 'NAME'
      ChkFldName(sFieldName)
  
	  case sDbfField = 'TYPE'
      ChkFldType(left(sType,1))

	  case sDbfField = 'LENGTH'
	    if childevent() = 1
	      select control 'EB.Length' at 1 size 3
	    else
        ChkFldLen(sLength, left(sType,1)) 
        ChkFldDec(sDecimal, sLength,left(sType,1))
      endif

	  case sDbfField = 'DECIMAL'
	    if childevent() = 1
	      select control 'EB.Decimal' at 1 size 2
	    else
        ChkFldDec(sDecimal, sLength, left(sType,1))
      endif

	endcase
  endif
return(.t.)


*********************
function ChkFldName()
*********************
parameter sFN
private lReturn

  lReturn = .t.

  if empty(alltrim(sFN))
	set message to csEnterFName
	lReturn = .f.
  else
	if lReturn
	  if .not. isalpha(left(alltrim(sFn),1))   
		beep
		set message to csFirstChara
		select CONTROL 'EB.Name'
		lReturn = .f.
	  endif
	endif    
	
	if lReturn
	  if .not. ValidChars(trim(sFn),',;"/.<>- ?*' + "'")
		beep
		sMessage =  csInvalidChar
		set message to sMessage
		select CONTROL 'EB.Name'
		lReturn = .f.
	  endif
	endif  
	
	if lReturn .and. reccount() > 0 
	  *: check for duplicate field names
	  msave_rec = recno()
	  goto top
	  locate for trim(field_name) = upper(trim(sFN))
	  if .not. eof() .and. recno() <> msave_rec
		beep
		sMessage = cesDuplicateField
		set message to sMessage
		lReturn = .f.
		select CONTROL 'EB.Name'
	  endif
	  go msave_rec
	endif
  endif
return(lReturn)


*********************
function ChkFldType()
*********************
parameter type

  store 0 to newlen, newdec

  do case
	case type = 'C'
	  newlen = 25
	case type = 'N'
	  newlen = 12
	  newdec = 2
	case type = 'D'
	  newlen = 8
	case type = 'L'
	  newlen = 1
	case type = 'M' .or. type = 'P'
	  newlen = 10
  endcase

  if newlen > 0 .and. newlen <> val(sLength)
		sLength = alltrim(str(newlen,3,0))
	if newdec <> val(sDecimal)
	  sDecimal = alltrim(str(newdec,2,0))
	endif
	update CONTROL 'EB.Length'
	update CONTROL 'EB.Decimal'
	if type $ 'DMLP'
		disable control 'EB.Length'
		disable control 'EB.Decimal'
	else
		enable control 'EB.Length'
		enable control 'EB.Decimal'
	endif
  endif
return(.T.)


********************
function ChkFldLen()
********************
parameters nLen, sType
private lReturn

  lReturn = .t.

  if empty(alltrim(nLen)) .or. .not. ValidNumber(alltrim(nLen))
	beep
	set message to csNotNumber
	select CONTROL 'EB.Length'    
	lReturn = .f.
  else 
	nLen = val(alltrim(nLen))

	do case
	  case sType = 'C'
		maxlen = 254
		minlen = 1
	  case sType = 'D'
		store 8 to maxlen, minlen
	  case sType = 'L'
		store 1 to maxlen, minlen
	  case sType $ 'MP'
		store 10 to maxlen, minlen
	  case sType = 'N'
		maxlen = 17
		minlen = 1
	endcase
 
	if (maxlen > 0 .and. (nLen > maxlen .or. nLen < minlen))
	  beep
	  do case
		case sType = 'C'
		  sMessage =  cesCharFldLen
		case sType = 'D'        
		  sMessage =  cesDateFldLen
		case sType = 'L'
		  sMessage =  cesLogFldLen
		case sType = 'M'
		  sMessage =  cesMemoFldLen
		case sType = 'N'
		  sMessage =  cesNumFldLen
		case sType = 'P'
		  sMessage =  cesPicFldLen
	  endcase
	  set message to sMessage
	  select CONTROL 'EB.Length'
	  lReturn = .f.
	endif
  endif
return(lReturn)


********************
function ChkFldDec()
********************
parameters fld_dec, fld_len, fld_type
private lReturn

  lReturn = .t.
  
  maxdec = 0
  if empty(alltrim(fld_Len)) .or. ;
	  ValidNumber(alltrim(fld_Len)) = FALSE
	beep
	set message to csNotNumber
	select CONTROL 'EB.Length'
	return(.f.)
   else 
	fld_Len = val(alltrim(fld_Len))
  endif    
  if empty(alltrim(fld_dec)) .and. lReturn = .t.
	if fld_type = 'N'
	  beep
	  set message to csDecReq
	  select CONTROL 'EB.Decimal'      
	  return(.f.)      
	 else 
	  fld_dec = '0'
	  sDecimal = '0' 
	  update control 'EB.Decimal'
	endif    
  endif  
  if ValidNumber(alltrim(fld_dec)) = FALSE .and. lReturn = .t.
	beep
	set message to 'Decimal entered, is not numeric'
	select CONTROL 'EB.Decimal'      
	return(.f.)
   else 
	fld_dec = val(alltrim(fld_dec))
  endif    

  if fld_dec > 0 .and. lReturn = .t.
	do case
	  case fld_type = 'N'
		maxdec = 15
		if fld_dec > maxdec
		  beep
		  sMessage = cesMaxDecFldLen
		  set message to sMessage
		  select CONTROL 'EB.Decimal'
		  lReturn = .f.
		endif
		if fld_dec > fld_len - 2
		  beep
		  set message to csDecTwoLess
		  select CONTROL 'EB.Decimal'
		  lReturn = .f.
		endif
	  otherwise
		if fld_dec > maxdec
		  beep
		  sMessage = cesNoDecAllowed
		  set message to sMessage
		  select CONTROL 'EB.Decimal'
		  lReturn = .f.
		endif
	endcase
  endif fld_dec <> 0
return(lReturn)


********************
function ModiClose()
********************
private sThePath, sTheName, sTheExt
		
  set message to ' '
  lConfirmed = .t.
  lCancel = .f.

  if sTheButton = bCancel     && cancel clicked in modi window 
	lChanged   = .f.          && Don't process changes(lChanged)
	lConfirmed = .f.    
	lCancel    = .t.
	if lActiveChanges
	  nRetVal = warning( csDataStru, csStruChange, 2)
	  if nRetVal = 1          && OK clicked    
		lConfirmed = .t.        
	  elseif nRetVal = 0     && cancel clicked 
		sThefile = ""   
		lChanged = .t.
	  endif  
	else   // no lActiveChanges
	  lConfirmed = .t.           
	endif  // lActiveChanges  
  endif   // nTotFields  

  if lChanged .and. .not. lCancel
	if lActiveChanges
	  if empty(sTheFile)
		if nTotFields > 0
		  sTheFile = saveas( csDataFileDBF, csNewFile )
		  if empty(sTheFile)
			nRetVal = 0         && user canceled
		  else 
			nRetVal = 1         && user clicked ok
		  endif            
		else  // nTotFields
		  nRetVal = -2          && discard any changes and exit
		endif  // nTotFields 
	  else  // .not. empty(sTheFile)
		if nTotFields > 0
		  nRetVal = warning( csDataStru, csSaveChange;
					+alltrim(sTheFile),130)     
		else   && No fields defined, but SaveAs was done           
		  if lnew
			nRetVal = warning( csDataStru, csAllDeleted;
					   +alltrim(sTheFile),1)
			if nRetVal = 1   && YES- user wants to abandon new structure
			  nRetVal = -2
			elseif nRetVal = -1  && NO-                               
			  nRetVal = 0
			endif  
		  else           && existing structure
			nRetVal = warning( csDataStru, csEraseFile, 1)
			if nRetVal = 1   && YES- user wants to erase original file 
			  nRetVal = -1
			elseif nRetVal = -1  && NO- 
			  nRetVal = 0
			endif   
		  endif  // lNew 
		endif  // nTotFields > 0
	  endif  // empty(sTheFile) 
	else // lActiveChanges
	  nRetVal = -2            && discard any changes and exit
	endif   // lActiveChanges   
	
	SplitPath(sTheFile, @sThePath, @sTheName, @sTheExt)         
	if empty(sTheExt) .and. nRetVal <> 0
	  sTheFile = sTheFile + '.DBF'    && create file extension
	endif
	
	if nRetVal = 1          && user clicked OK
	  set cursor to wait
	  if nTotFields > 0
		if lNew
		  create &sTheFile from &sTempDbf1
		else
		  sTempDbf2 = tempfile(2)
		  create &sTempDbf2 from &sTempDbf1
		  use &sTempDbf2
		  append from &sTheFile
		  use

		  erase &sTheFile
		  if file(sThePath + sTheName + '.DBT')
			erase &sThePath.&sTheName..DBT 
		  endif
					
		  copy file &sTempDbf2..DBF to &sTheFile
		  erase &sTempDbf2..DBF
		  if file(sTempDbf2 + '.DBT')
			copy file &sTempDbf2..DBT to &sThePath.&sTheName..DBT 
			erase &sTempDbf2..DBT 
		  endif
		endif  // lNew  
	  else      &&  nTotFields = 0
*:       User has OK'd deleting the permanent structure file
				if .not. lNew
		  erase &sTheFile
		  if file(sThePath + sTheName + '.DBT')
			erase &sThePath.&sTheName..DBT 
		  endif
		endif    
	  endif    &&  nTotFields > 0
	  lChanged = .f.
	  nAction = -1
	  use
	  erase &sTempDbf1..DBF
	elseif nRetVal = -1     && user clicked NO
	  if nTotFields = 0        
		erase &sTheFile
		if file(sThePath + sTheName + '.DBT')
		  erase &sThePath.&sTheName..DBT 
		endif
	  endif  
	  lChanged = .f.
	  nAction = -1
	  use
	  erase &sTempDbf1..DBF

	elseif nRetVal = -2    && user clicked close without any changes
	  lChanged = .f.
	  nAction = -1
	  use
	  erase &sTempDbf1..DBF              

	elseif nRetVal = 0     && user clicked Cancel from dialog window,        
						   && simply return
	endif  // nRetVal 
  else   && .not. lchanged   
	if lconfirmed = .t.     && discard any changes
	  nAction = -1   
	  use
	  erase &sTempDbf1..DBF   
	endif  
  endif  // lChanged
  set cursor to arrow  
  set message to ''
 
return(.f.)


*********************
function ModiSaveAs()
*********************
Private sThePath, sTheName, sTheExt

  sTheFileX = saveas( csDataFileDBF, csNewFile )
  
  if .not. empty(sTheFileX)  // cancelled? 
	sTheFile = sTheFileX     // No
	SplitPath(sTheFile, @sThePath, @sTheName, @sTheExt)         
	if empty(sTheExt) 
	  sTheFile = sTheFile + '.DBF'    && create file extension
	endif
	if lNew
	  set window title to csCreate + ' ' + ;
			csStructure + ' - [' + MakeTitle(sTheFile) + ']'
	else
	  set window title to csModify + ' ' + ;
		  csStructure + ' - [' + MakeTitle(sTheFile) + ']'
   endif
   lNew = .t.
   lActiveChanges = .t.   
 endif  
return(.f.)


********************
function MakeTitle()
********************
parameter sTheFile
private sTitle, sThePath, sTheName, sTheExt

  if len(sTheFile) > 28
	SplitPath(sTheFile, @sThePath, @sTheName, @sTheExt)
	sTitle   = left(sThePath,3) + '...\' + sTheName + '.' + sTheExt
  else
	sTitle   = sTheFile
  endif
return(sTitle)


******************
function ModiAdd()
******************
parameter lSayDone

  if lAdding
	return(.t.)
  endif
  
  if pcount() = 0
	lSayDone = .t.
  endif
  
  if reccount() = cnMaxFields
	warning( csTooManyFlds, cesMaxFields, 3)
  elseif nRecSize > cnMaxFieldSize-1
	beep
	sMessage = cesGT3999Bytes
	set message to sMessage
	select CONTROL 'EB.Length'
  else
	append blank
	sFieldName = ''
	sType = 'C'
	sLength = '25'
	sDecimal = '0'
	replace ;
	  field_name with sFieldName, ;
	  field_len with val(sLength), ;
	  field_dec with val(sDecimal), ;
	  field_type with sType
	commit

	goto bottom
	nRec = recno()
	arFieldInfo[nRec + 1] = field_name + chr(9) + field_type + chr(9) + ;
	  str(field_len,3) + chr(9) + str(field_dec,2)
	sRecord = arFieldInfo[nRec + 1]

	replace listbox 'LB.Modi' with arFieldInfo
	update CONTROL 'EB.Name'
	update CONTROL 'CB.Type'
	update CONTROL 'EB.Length'
	update CONTROL 'EB.Decimal'
	update CONTROL 'LB.Modi'
	ShowFieldInfo(.f.)

	store .t. to lChanged, lAdding

		disable button bCancel
	disable button bSaveAs
	disable button bInsert
	disable button bDelete
	disable button bClose

		if lSayDone    
		replace control bAdd with bDone
	  endif

	select CONTROL 'EB.Name'

	@ 0,1
	@ 0,1 say csAddField

	set message to ''
  endif
return(.f.)


******************
function ModiIns()
******************

  if reccount() = cnMaxFields
	warning( csTooManyFlds, cesMaxFields,3 )

  elseif nRecSize > cnMaxFieldSize-1
	warning( csRecTooLarge, cesGT3999Bytes,3 )

  else
	insert blank before
	sFieldName = ''
	sType = 'C'
	sLength = '25'
	sDecimal = '0'
	replace ;
	  field_name with sFieldName, ;
	  field_len with val(sLength), ;
	  field_dec with val(sDecimal), ;
	  field_type with sType
	commit
	nRec = recno()

	operation = aInsert

	disable button bSaveAs
	disable button bClose
	disable button bInsert
	disable button bAdd
	disable button bDelete

	set cursor to arrow

	i = nTotFields + 2
	do while i > nRec + 1
	   arFieldInfo[i] = arFieldInfo[i - 1]
	   dec i
	enddo

	arFieldInfo[nRec + 1] = sFieldName + chr(9) + sType + chr(9) + ;
	  rtjust(sLength,3) + chr(9) + rtjust(sDecimal,2)      
	  
	sRecord = arFieldInfo[nRec + 1]

	replace listbox 'LB.Modi' with arFieldInfo
	update CONTROL 'LB.Modi'

	ShowFieldInfo(.f.)

	@ 0,1
	@ 0,1 say csInsert
	set message to ''
	store .t. to lInserting, lChanged  && if we move this before the
									   && the call to ShowFieldInfo()
									   && than ShowFieldInfo() will
									   && think we are canceling the
									   && action
  endif
return(.f.)


******************
function ModiDel()
******************

  if confirm( csReallyDelete )

	nRecSize = nRecSize - a->Field_Len
	nRec = recno()
	delete
	pack

	for i = nRec + 1 to nTotFields + 1
	  arFieldInfo[i] = arFieldInfo[i + 1]
	next i
	
	dec nTotFields
	dec nRec
	
	sRecord = arFieldInfo[nRec + 1]
	replace listbox 'LB.Modi' with arFieldInfo
	update CONTROL 'LB.Modi'
	
	if nTotFields = 0
	  ModiAdd()
	  enable button bClose
	  update CONTROL 'EB.Name'
	  update CONTROL 'CB.Type'
	  update CONTROL 'EB.Length'
	  update CONTROL 'EB.Decimal'
	  disable button bDelete
	else
	  nRecordNum = nRec
	  ShowFieldInfo(.f.)
	endif

	lChanged = .t.
	set message to ''
	@ 14, 0 say csNumFieldsCol + str(nTotFields,3)
	@ 14,27 say csRecSize + str(nRecSize,4)
	lActiveChanges = TRUE
  endif
return(.f.)


******************************
function TempFile(nFileNumber)
******************************
parameter nFileNumber
private sTFileName
	
	sTFileName = sTempDir + 'T$' + station() + substr(str(1000 + nFileNumber,4),2,3)
	if file(sTfileName + '.dbf')
	  erase &sTFileName..dbf
	endif  
return(sTFileName)


*********************
function ReadDialog()
*********************
parameter dfltobj
private nTheEvent, nRetVal, sTheButton, nTheKey

  set eventmsk to 128 + 16 + 8 + 4 + 1

  chkevent()

  if .not. empty(dfltobj)
	select CONTROL dfltobj
  endif

  do while .t.
	nRetVal = IDCANCEL

	nTheEvent = modalevent(.f.)

	sTheWindow = window()
	sTheButton = button()
	nTheKey    = lastkey()
	
	do case
	  case nTheEvent = eWindow
		if sTheWindow <> sDlgWindow
		  select window sDlgWindow
		endif

	  case nTheEvent = eButton
		do case
		  case sTheButton = bCancel
			nRetVal = IDCANCEL
		  otherwise
			nRetVal = IDOTHER
		endcase
		exit

	  case nTheEvent = eKybd
		do case
		  case nTheKey = kEsc
			nRetVal = IDCANCEL
			exit
		  case nTheKey = kEnter
			if IsObjEnabled(bClose,-1)
			  nRetVal = IDOK
			  exit
			else
			  if .not. empty(dfltobj)
				select CONTROL dfltobj
			  endif
			  beep
			endif
		endcase

	  case nTheEvent = eClose
		if IsObjEnabled(bClose,-1)
		  nRetVal = IDOK
		else
		  nRetVal = IDCANCEL
		endif
		exit
	endcase
  enddo
  set eventmsk to 159
return(nRetVal)


*********************
function ValidChars()
*********************
parameters sCheckName, sChars
private lReturn

  lReturn = .t.
  for nX = 1 to len(sCheckName)
	if substr(sCheckName,nX,1) $ sChars
	  lReturn = .f.
	  exit
	endif
  next nX
return(lReturn)


**********************
function Validnumber()
**********************
parameters sCheckNum  
private lReturn
 
  lReturn = .t.
  if  len(sCheckNum) <> 0
	for nX = 1 to len(sCheckNum)
	  if .not. (substr(schecknum,nX,1) >= '0' .and. substr(schecknum,nX,1) <= '9')
		lReturn = .f.
		exit
	  endif   
	next  
  else 
	 lreturn = .f.
  endif   
return(lReturn)  


********************
procedure MakeDialog
********************
parameter sTitle, nHeight, nWidth, nButtons, lDisableClose

  nReturn = .t.
  if nWidth > 79 .or. nWidth < 20 .or. nHeight > 24 .or. nHeight < 4
	showerror('MakeDialog', csErrParameter )
	nReturn = .f.
  else
	nTopRow = int((24 - (nHeight + 1)) / 2)
	if nTopRow > 7
	  nTopRow = int((16 - (nHeight + 1)) / 2)
	endif
	nTopCol = int((79 - nWidth) / 2)
	nBotRow = nTopRow + (nHeight + 1)
	nBotCol = nTopCol + nWidth
	*:
	sDlgWindow = sTitle
	set window type to 1060
	create window sTitle from nTopRow,nTopCol to nBotRow,nBotCol style HIDDEN
	set erase video to 240
	erase
	*:
	nButtonRow = 0
	if bitand(nButtons,4)
	  create button bClose  at nButtonRow,nWidth - 10 size 1,8 plain
	  nButtonRow = nButtonRow + 2
	endif
	*:
	if bitand(nButtons,2)
	  create button bCancel at nButtonRow,nWidth - 10 size 1,8 plain
	  nButtonRow = nButtonRow + 2
	endif
  endif
return


******************
Procedure CheckErr
******************
  
	if error() = 42
	beep
	warning( csDataFile + ' - [' + upper(sTheFile) + ']', ;
		csNotDatabase, 387)
  elseif error() = 78 
		*: user probably cancelled a drive not ready
  else  
	s1 = csDosError + alltrim(str(doserror()))
	s2 = s1 + csdBFastError + alltrim(str(error()))
	s3 = s2 + csLineNum + alltrim(str(procline()))
	s4 = s3 + csProcName + procname()
	beep
	warning( csDosFileErr, s4, 387 )
  endif
  lWasError = .f.
  
return


*************************************************
function SplitPath(sTheFileName,sPath,sFile,sExt)
*************************************************
parameter sTheFileName, sPath, sName, sExt
private nBackSlash, nDot

  store '' to  sPath, sName, sExt 

  nBackSlash = rat('\',sTheFileName)
  nDot       = rat('.',sTheFileName)
  
  sPath = left(sTheFileName,nBackSlash)
  sName = substr(sTheFileName,nBackSlash + 1,(nDot - nBackSlash) - 1)
  if nDot > 1
	sExt = right(sTheFileName,len(sTheFileName) - nDot)
  endif
return(.t.)

