home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
homonlib.zip
/
EDSTR.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-04-13
|
9KB
|
219 lines
DEFINT A-Z
' $INCLUDE: 'EDSTR.INC'
' $INCLUDE: 'PARM.INC'
' $INCLUDE: 'SETCURS.INC'
'(Function declaration is in the include file)
'External procedures:
DECLARE FUNCTION GetKey$ (parm())
DECLARE FUNCTION PadR$ (o$, n)
DECLARE FUNCTION Stuff$ (o$, p, d, c$)
FUNCTION EdStr$ (orig$, parm())
'****************************************************************************
'Used to edit an existing string or for input of a new string.
'
'If the user presses ESC during the editing, CHR$(27) will be returned to let
' the calling procedure know it was aborted.
'
'If Enter is pressed to terminate the editing, the edited string will be
' returned.
'
'The settings of the miscellaneous parameters are as follows:
'
' parm(1) = row
' parm(2) = column
' parm(3) = maximum length of the edited string 1-80
' parm(4) = insert/overwrite mode (Use SETCURS.INC constants)
' parm(5) = initial cursor position within string 0=Beginning
' parm(6) = use delimiters? (0=No Non-zero=Yes)
' parm(7) = left delimiter ASCII code. Default = 62 ( > )
' parm(8) = right delimiter ASCII code. Default = 60 ( < )
' parm(9) = use selected colors? 0=Current colors Non-zero=Selected
' parm(10)= used to restrict user input. See EDSTR.INC for values.
'
'EdStr$() works just like you're used to, with all the familiar editing keys:
' Left/right arrows, Backspace, Delete, Insert/overwrite, Home, and End. It
' also has a special service, Alt-X, that deletes from the cursor position to
' the end of the line.
'
'The maximum length of the edited string depends on whether delimiters are
' used or not. Without delimiters, the string may be up to 80 characters
' long. With delimiters, it is reduced to 78.
'
'If you choose to have EdStr$() appear in the highlighted colors, it will
' reset the colors to normal upon exit. If not, the current color setting
' will not be changed at all.
'
'If parm(10) is greater than zero, user input will be limited to certain
' characters. See EDSTR.INC for the constant names. You may add these
' constants together to get different combinations of allowed characters.
'
' Example: parm(10) = EDUPPER + EDALPHA + EDSPACE
'
' This would allow spaces and uppercase letters only.
'
'The combinations allowed for parm(10) are not extensive by any means, but
' for simple input they can be handy.
'
'****************************************************************************
'Preliminary setup:
row = parm(1) 'Row
col = parm(2) 'Column
maxlen = parm(3) 'Max length
inov = parm(4) 'Insert/Overwrite mode
IF inov <> SCINS AND inov <> SCOVR THEN inov = SCINS ' (default = Insert)
spos = parm(5) 'Initial position
IF spos < 1 OR spos > maxlen THEN spos = 1
s$ = RTRIM$(orig$)
IF spos > LEN(s$) THEN s$ = PadR$(s$, spos)
IF LEN(s$) > maxlen THEN s$ = LEFT$(s$, maxlen)
IF parm(6) <> 0 THEN 'Delimiters?
x = parm(7)
IF x < 1 OR x > 255 THEN x = 62
ld$ = CHR$(x)
x = parm(8)
IF x < 1 OR x > 255 THEN x = 60
rd$ = CHR$(x)
IF parm(9) THEN COLOR parm(FGS), parm(BGS)
LOCATE row, col
PRINT ld$; SPACE$(maxlen); rd$
col = col + 1
END IF
IF (parm(10) AND EDUPPER) THEN s$ = UCASE$(s$) 'Upper case?
sp$ = " " 'For optimization.
oldcursor = SetCursor(inov) 'Retain the previous cursor value.
DO 'The main loop!
IF spos < LEN(s$) THEN 'Trim trailing spaces beyond spos
last = spos
FOR x = (spos + 1) TO LEN(s$)
IF MID$(s$, x, 1) <> sp$ THEN last = x
NEXT x
s$ = LEFT$(s$, last)
END IF
IF parm(9) THEN COLOR parm(FGS), parm(BGS) 'Use selected color?
LOCATE row, col 'Show the string.
PRINT PadR$(s$, maxlen);
LOCATE row, col + spos - 1 'Position the cursor.
IF parm(9) THEN COLOR parm(FGN), parm(BGN) 'Reset colors if changed.
k$ = GetKey$(parm()) 'Get keyboard input:
a = ASC(LEFT$(k$, 1))
SELECT CASE a
CASE 13 'Enter - finished
EXIT DO
CASE 27 'ESC - abort
s$ = k$ 'Return CHR$(27)
EXIT DO
CASE 8 'Backspace
IF spos > 1 THEN
spos = spos - 1
s$ = Stuff$(s$, spos, 1, "")
END IF
CASE 32 TO 126 'Normal typing
IF parm(10) THEN GOSUB CheckInput
IF LEN(k$) THEN 'Was it allowed?
IF inov = SCOVR THEN
s$ = Stuff$(s$, spos, 1, k$)
spos = spos + 1
ELSEIF LEN(s$) < maxlen THEN
s$ = Stuff$(s$, spos, 0, k$)
spos = spos + 1
ELSEIF LEN(s$) = maxlen AND RIGHT$(s$, 1) = " " THEN
MID$(s$, spos, 1) = k$
END IF
END IF
CASE 0
SELECT CASE ASC(RIGHT$(k$, 1))
CASE 45 'Alt-X - delete to end
IF spos > 1 THEN ' of line
s$ = LEFT$(s$, spos - 1)
ELSE
s$ = sp$
END IF
CASE 71 'Home
spos = 1
CASE 75 'Left Arrow
spos = spos - 1
CASE 77 'Right Arrow
spos = spos + 1
CASE 79 'End
spos = LEN(s$)
IF spos < maxlen AND RIGHT$(s$, 1) <> sp$ THEN
s$ = s$ + sp$
spos = spos + 1
END IF
CASE 82 'Insert - toggle mode
IF inov = SCINS THEN
inov = SCOVR
ELSE
inov = SCINS
END IF
x = SetCursor(inov)
CASE 83 'Delete
IF spos < LEN(s$) THEN
s$ = Stuff$(s$, spos, 1, "")
ELSE
MID$(s$, spos, 1) = sp$
END IF
CASE ELSE
'Ignore it
END SELECT
CASE ELSE
'Ignore it
END SELECT
IF spos < 1 THEN spos = 1
x = LEN(s$)
IF spos = x + 1 AND spos <= maxlen THEN
IF RIGHT$(s$, 1) <> sp$ OR parm(10) = EDANY OR (parm(10) AND EDSPACE) > 0 THEN
s$ = s$ + sp$
x = x + 1 'Allow them to move past the end if there
END IF 'is room for it & spaces are allowed.
END IF 'Always allow at least one to the right.
IF spos > x THEN spos = x
IF spos > maxlen THEN spos = maxlen
LOOP
x = SetCursor(oldcursor) 'Restore cursor to previous value.
EdStr$ = RTRIM$(s$) 'Trim any trailing spaces.
EXIT FUNCTION 'Avoid the RETURN WITHOUT GOSUB!!!
CheckInput:
IF (parm(10) AND EDUPPER) THEN k$ = UCASE$(k$) 'If EDUPPER only, no
IF parm(10) = EDUPPER THEN RETURN 'other restrictions.
SELECT CASE a
CASE 32 'space
IF (parm(10) AND EDSPACE) = 0 THEN k$ = ""
CASE 45, 46 '- or .
IF (parm(10) AND EDDEC) = 0 THEN k$ = ""
CASE 48 TO 57 '0-9
IF (parm(10) AND EDNUM) = 0 THEN k$ = ""
CASE 65 TO 90, 97 TO 122 'A-Z or a-z
IF (parm(10) AND EDALPHA) = 0 THEN k$ = ""
CASE ELSE
k$ = ""
END SELECT
RETURN
END FUNCTION