Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : STRALEY.ZIP
Filename : EDIT.PRG

********************
* Name EDIT.prg
* Date August 18, 1986
* Notice Copywright 1986, Stephen J. Straley
* Note This program emulates the EDIT command of dBASEIII.
* One exception is on a field larger than the width
* of the screen: this program will allow a window for
* the edit to take place.
*
* A limitation to this program is that it will only work
* with 15 fields or fewer. However, minor modifications
* can be made allowing it to accept databases with
* more fields.
*
* Additionally, the way Memos and lengthy string fields
* are handled are a bit different in this simulation than
* in dBASEIII/Plus.
*
********************

PARAMETER file

file = UPPER(TRIM(file)) + ".DBF"
DO Openfile
frame = "ÉÍ»º¼ÍȺ "
DO Drawbord

**********************************************************************
* Variable Declaration *
* *
* howmany = the number of fields in database *
* screens = the number of screens *
* pan = this variable was set up to test for which screen *
* position. *
* recnumb = was initialized to store the current record number *
* good_time = a logical variable to allow for an update or not *
* nullstr = a null string variable that is to be global and *
* used for multi-purposes *
**********************************************************************

howmany = ENDFIELD()
* The operator is an addition that shows the modulus of two
* numbers
screens = INT(IF(howmany % 15 > 0, howmany / 15 + 1, howmany / 15))
recnumb = 1
pan = 1
nullstr = ""
good_time = .T.

SET KEY 28 TO && Turns off On-Line Help
SET KEY -1 TO Deltit
SET KEY -9 TO Quitit
SET KEY 5 TO Upit
SET KEY 24 TO Dwit
DECLARE tempdata[15] && This array holds the data for one
* && screen
GO TOP
STORE SPACE(4000) TO newscr
CALL _scrsave WITH newscr
DO WHILE .T.
DO Adjust
CALL _scrrest WITH newscr
DO Dispstat
DO Scrnstat
x = 1
DO WHILE x <= 15
good_time = .T.
intemp = FIELDNAME(x)
tempdata[x] = &intemp
IF EMPTY(intemp)
EXIT
ENDIF
DO CASE
CASE TYPE(intemp) = "M"
@ 6+x,12 SAY ""
tempvar = INKEY(0)
IF tempvar = 5
x = x - 1
LOOP
ENDIF
good_time = .F.

CASE TYPE(intemp) = "C"
IF LEN(tempdata[x]) > 60
@ 6+x,12 SAY ""
tempvar = INKEY(0)
IF tempvar = 5
x = x - 1
LOOP
ENDIF
good_time = .F.
ELSE
@ 6+x,12 GET tempdata[x]
READ
ENDIF

CASE TYPE(intemp) = "D"
dat_disp = DTOC(tempdata[x])
@ 6+x,12 GET dat_disp PICT "99/99/99" VALID(GOOD_DATE())
READ
tempdata[x] = CTOD(dat_disp)

OTHERWISE
@ 6+x,12 GET tempdata[x]
READ
ENDCASE
IF good_time
REPLACE &intemp WITH tempdata[x]
ENDIF
DO CASE
CASE LASTKEY() = 3
x = 15
CASE LASTKEY() = 18
x = 15
SKIP - 1
CASE LASTKEY() = 27 .OR. LASTKEY() = 17
@ 24,00 SAY ""
QUIT
CASE LASTKEY() = 29
IF TYPE(intemp) = "M" .OR. (TYPE(intemp) = "C" .AND. LEN(tempdata[x]) > 60)
newtemp = &intemp
DO Editit
REPLACE &intemp WITH newtemp
ENDIF
CASE LASTKEY() = 5
x = x - 1
ENDCASE

x = x + 1

ENDDO
DO CASE
CASE LASTKEY() = 13 .OR. LASTKEY() = 24 .OR. LASTKEY() = 3
SKIP
CASE LASTKEY() = 5
SKIP - 1
ENDCASE

ENDDO

********************

PROCEDURE Scrnstat


FOR y = 1 TO 15

intemp = FIELDNAME(y)
tempdata[y] = &intemp

IF EMPTY(intemp) && check to see if the field
RETURN && is actually there. If not,
ENDIF && then return to calling proc

@ 6+y,00 SAY FIELDNAME(y)
SET COLOR TO 0/7
DO CASE
CASE TYPE(intemp) = "M"
@ 6+y,12 SAY "memo"
CASE TYPE(intemp) = "C"
IF LEN(tempdata[y]) > 60
@ 6+y,12 SAY "string"
ELSE
@ 6+y,12 SAY tempdata[y]
ENDIF
CASE TYPE(intemp) = "D"
dat_disp = DTOC(tempdata[y])
@ 6+y,12 SAY dat_disp
OTHERWISE
@ 6+y,12 SAY tempdata[y]
ENDCASE
SET COLOR TO

NEXT

********************


FUNCTION GOOD_DATE

IF dat_disp = " / / "
outval = .T.
ELSE
outval = IF(CTOD(dat_disp) == CTOD(" / / "), .F., .T.)
ENDIF
IF outval
tempdata[x] = CTOD(dat_disp)
ELSE
SAVE SCREEN
@ 00,35 SAY SPACE(44)
@ 00,35 SAY "Invalid date. (Press SPACE)"
IF INKEY(0) = 0
ENDIF
RESTORE SCREEN
ENDIF
RETURN(outval)

********************

PROCEDURE Editit

SAVE SCREEN
@ 2,62 SAY " Memo Edit "
@ 3,62 SAY "Begin Edit ^Home"
@ 4,62 SAY "Abort Edit ESC"
@ 5,62 SAY "Save/Quit F10"
SET COLOR TO 0/7
SET FUNCTION 10 TO CHR(23)
SET KEY -1 TO
SET KEY -9 TO
SET KEY 5 TO
SET KEY 24 TO
newtemp = MEMOEDIT(newtemp,6+x,12,6+x,70,.T.)
RESTORE SCREEN
SET FUNCTION 10 TO
SET COLOR TO 7/0
SET KEY -1 TO Deltit
SET KEY -9 TO Quitit
SET KEY 5 TO Upit
SET KEY 24 TO Dwit

********************

PROCEDURE Openfile

IF file = "."
file = SPACE(14)
@ ROW(),0 SAY "No database is in USE. Enter file name: " GET file PICTURE "!!!!!!!!!!!!!!"
READ
file = TRIM(file)
x = AT(".",file)
IF X = 0
file = file + ".DBF"
ENDIF
ENDIF
IF .NOT. FILE("&file")
? file + " not found"
WAIT
QUIT
ENDIF
USE &file
CLEAR
SET SCOREBOARD OFF
GO TOP
RETURN

********************

PROCEDURE Drawbord

*
* Draw the border of EDIT
*

@ 0,1 SAY "Record No. "
@ 0,60 SAY TRIM(file)
@ 1,0,6,79 BOX frame
FOR aa = 20 to 60 STEP 20
@ 1,aa SAY "Ë"
@ 6,aa SAY "Ê"
NEXT
FOR aa = 2 to 5
@ aa,20 SAY "º"
@ aa,40 SAY "º"
@ aa,60 SAY "º"
NEXT
@ 2,2 SAY "CURSOR <-- -->"
@ 3,2 SAY "Char: <- ->"
@ 4,2 SAY "Field: ^<- ^->"
@ 2,22 SAY " UP DOWN"
@ 3,22 SAY "Rec:  "
@ 4,22 SAY "Page: PgUp PgDn"
@ 5,22 SAY "File: Home End"
@ 2,42 SAY " DELETE"
@ 3,42 SAY "Char: DEL"
@ 4,42 SAY "Field: ^Y"
@ 5,42 SAY "Record: F2"
@ 2,62 SAY " EDIT"
@ 3,62 SAY "Begin Edit ^Home"
@ 4,62 SAY " "
@ 5,62 SAY "Save/Quit F10"
RETURN


********************

PROCEDURE Deltit

PARAMETERS p,l,v

IF DELETED()
@ 00,38 SAY " "
RECALL
ELSE
@ 00,38 SAY "*DEL*"
DELETE
ENDIF

********************

PROCEDURE Upit

PARAMETERS p,l,v

good_time = .F.
REPLACE &intemp WITH tempdata[x]
CLEAR GETS
x = x - 1
IF x < 1
x = 18
ENDIF

********************

PROCEDURE Dwit

PARAMETERS p,l,v

KEYBOARD CHR(13)

********************

PROCEDURE Quitit

PARAMETERS p, l, v

CLEAR
CLOSE DATABASES
QUIT

********************

PROCEDURE Endmemo

PARAMETERS p, l, v

* This procedure is called by a SET KEY TO command and simulates
* a control W key being pushed, thus completing a MEMOEDIT().

KEYBOARD CHR(23)

********************

PROCEDURE Dispstat

* This proecdure displays a message if the record in the active
* and selected database is deleted.

@ 00,15 SAY LTRIM(STR(RECNO()))
IF DELETED()
@ 00,38 SAY "*DEL*"
ENDIF

********************

PROCEDURE Adjust

* This should be done with most all applications. This simple routine
* re-adjusts the pointer of the currently selected and active database
* to the proper position. Sometimes, an image of a record appears of
* the EOF() of BOF() in a READ command. This proecdure adjusts this
* from happening.

IF BOF()
GO TOP
ELSE
IF EOF()
GO BOTTOM
ENDIF
ENDIF

********************

PROCEDURE Loadarry

FOR x = 1 TO howmany
temp = FIELDNAME(x) && because we cant go directly to the array

atype[x] = TYPE(temp)
names[x] = temp
DO CASE
CASE atype[x] = "C"
length[x] = LEN(temp)
CASE atype[x] = "D"
length[x] = 8
CASE atype[x] = "N"
length[x] = 10
ENDCASE
NEXT

********************

FUNCTION Endfield

* This function determines the number of the last field in database given
PARAMETERS File

x = 1
y = 1024
z = int(y/2)
DO WHILE X <> Y
IF LEN(FIELDNAME(z)) = 0
y = z
ELSE
x = z
ENDIF
z = x + int((y-x)/2)
IF LEN(FIELDNAME(z)) > 0 .AND. LEN(FIELDNAME(z+1)) = 0
y = z
x = z
ENDIF
ENDDO
RETURN(Y)

********************

FUNCTION Bitstrip

PARAMETERS c

outstring = ""
beginning = 1
DO WHILE .NOT. EMPTY(c)
IF AT(CHR(141),c) = 0
outstring = outstring + SUBSTR(c,beginning,LEN(c))
c = ""
ELSE
outstring = outstring + SUBSTR(cmbeginning,AT(CHR(141),c)-1)
beginning = AT(CHR(141),c)+1
c = SUBSTR(c,beginning,LEN(c) - beginning + 1)
beginning = 1
ENDIF

ENDDO
RETURN(outstring)

********************

FUNCTION Big_screen

PARAMETERS temp_row

SET KEY 13 TO Endmemo
data[x] = MEMOEDIT(data[x],temp_row,10,temp_row,80,.T.)
SET KEY TO
data[x] = BITSTRIP(data[x])
RETURN(.T.)