Download text file
'------------------------------------------------------------------------
' fInput% function for Qbasic
' coded by: Don Schullian d83@DASoftVSS.com
' public domain
'
' Welcome,
'
' This code is offered as an (better?) alternative to INPUT$. It
' allows for cursoring around a field, deletion, insertion, overwrite,
' scrolling, and bail out without saving the/any changes.
'
' Its use is demonstrated below using an array to allow for editing
' a screen full of data in one loop. This code could, very easily be
' placed into it's own function and called several times in a single
' program.
'
' There are a series of CONSTant variables set that are used by the
' function. You may, of course, put their values into the function or,
' in some cases, send the values to the function to allow for more
' control by varied other functions.
'
' This offering is just a starting point for those of you who are
' more adventurous. Over the years I've developed 10 different
' variations of this function that control and guide the users' input.
' One of them works only for numerical input and looks & feels like
' a calculator; another allows input of only specific characters;
' while others handle hexadecimal input, masked fields, multiple lines
' and other varied field types. A bit of imagination goes a LONG way!
'
' fGetKey% is my basic keyboard input function and I never leave
' home without it. There is a full discussion on how and why on
' either of my web pages. www.basicguru.com/scullian or
' www.DASoftVSS.com along with some other goodies.
'
' If you have any questions, give me a shout.
'
' Don
'----------------------------------------------------------------------
' fGetKey%(Datum$,Row%,Col%,VisCols%,MaxLen%,ExitKeys$)
'
' PURPOSE: Allow user input in an editable, friendly environment
' PARAMS: Datum$ incoming the data already found in the field
' returning the edited data
' Row%, Col% the left most screen position of the field
' VisCols% the number of visable characters on screen
' MaxLen% the maximum number of characters in the field
' ExitKeys$ the MKI$(keyvalue%) of all the keys OTHER THAN
' and that will return from the
' function
' NOTE: If VisCols% =< MaxLen% then the value will be set to match
' that of MaxLen%
'--------------------------------------------------------------------------
DECLARE FUNCTION fGetKey% ()
DECLARE FUNCTION fInput% (Datum$, Row%, Col%, VisCols%, MaxLen%, ExitKeys$)
CONST cEscKey% = &H1B
CONST cEnterKey% = &HD
CONST cBkSpcKey% = &H8
CONST cDelKey% = &H5300
CONST cUpKey% = &H4800
CONST cDownKey% = &H5000
CONST cInsKey% = &H5200
CONST cLeftKey% = &H4B00
CONST cRightKey% = &H4D00
CONST cF10key% = &H4400
CONST cHomeKey% = &H4700
CONST cEndKey% = &H4F00
CONST cFgrnd% = 15 ' editing foreground
CONST cBgrnd% = 1 ' editing background
CONST cMaxLen% = 80 ' maximum length used by fInput%
TYPE InputTYPE ' used to store a screen full of data
Dat AS STRING * cMaxLen ' the field of data
Row AS INTEGER ' screen position
Col AS INTEGER '
MaxLen AS INTEGER ' maximum data length for this field
END TYPE
'---------------------------------------------------------------
'-------------------- start of test code
'---------------------------------------------------------------
CLS
' ================================================
' ======= this demonstrates the use for one field
' ================================================
D$ = "Mary had a little lamb, its fleece was white as snow."
G% = fInput%(D$, 1, 10, 20, 70, "")
LOCATE 2, 1: PRINT D$;
' ==================================================
' ====== the following uses an array for 5 fields
' ==================================================
DIM tI(5) AS InputTYPE
RESTORE TestData
FOR X% = 1 TO 5
READ Prompt$
READ tI(X%).Dat, tI(X%).Row, tI(X%).Col, tI(X%).MaxLen
Col% = tI(X%).Col - LEN(Prompt$) - 1
COLOR 7, 0
LOCATE tI(X%).Row, Col%
PRINT Prompt$;
COLOR 15, 0
LOCATE tI(X%).Row, tI(X%).Col
PRINT LEFT$(tI(X%).Dat, tI(X%).MaxLen)
NEXT
LOCATE 25, 1: PRINT "Use Arrows to move - F-10 to save & exit - to quit";
ExitKeys$ = MKI$(cF10key%) + MKI$(cUpKey%) + MKI$(cDownKey%)
Fld% = 1
DO
IF Fld% < 1 THEN
Fld% = 5
ELSEIF Fld% > 5 THEN
Fld% = 1
END IF
G% = fInput%(tI(Fld%).Dat, tI(Fld%).Row, tI(Fld%).Col, 0, tI(Fld%).MaxLen, ExitKeys$)
SELECT CASE G%
CASE cF10key: EXIT DO
CASE cEscKey: EXIT DO
CASE cUpKey: Fld% = Fld% - 1
CASE ELSE: Fld% = Fld% + 1
END SELECT
LOOP
FOR X% = 1 TO 5
LOCATE X% + 10, 1
PRINT tI(X%).Dat
NEXT
TestData:
DATA "Last Name:", "Schullian", 6, 20, 17
DATA "Frst Name:", "Don", 7, 20, 17
DATA "Street:", "My Street 27", 8, 20, 30
DATA "City:", "Hometown", 9, 20, 30
DATA "Zip:", "12345-2433", 9, 56, 10
'
FUNCTION fGetKey%
DO
G$ = INKEY$
L% = LEN(G$)
LOOP UNTIL L% > 0
IF L% = 1 THEN
fGetKey% = ASC(G$)
ELSE
fGetKey% = CVI(G$)
END IF
END FUNCTION
FUNCTION fInput% (Datum$, Row%, Col%, VisLen%, MaxLen%, ExitKeys$)
DIM Bgrnd AS INTEGER ' original background color
DIM Cpos AS INTEGER ' current cursor position within string
DIM Exet AS STRING ' string vals of all exit keys
DIM Fgrnd AS INTEGER ' original foreground color
DIM Inzert AS INTEGER ' insert state
DIM KeyVal AS INTEGER ' incoming key-press value
DIM MaxOff AS INTEGER ' maximum offset position
DIM Offset AS INTEGER ' 1st character shown in field
DIM Temp AS STRING * cMaxLen ' working data string
Temp$ = LTRIM$(LEFT$(Datum$, MaxLen%))
Inzert% = 31
Exet$ = MKI$(cEscKey%) + MKI$(cEnterKey%) + ExitKeys$
Bgrnd% = SCREEN(Row%, Col%, 1)
Fgrnd% = (Bgrnd% AND 15)
Bgrnd% = (Bgrnd% \ 16)
Offset% = 1
IF (VisLen% = 0) OR (VisLen% > MaxLen%) THEN VisLen% = MaxLen%
MaxOff% = (MaxLen% - VisLen% + 1)
GOSUB fInputEOL
COLOR cFgrnd%, cBgrnd%
LOCATE , , , Inzert%, 31
DO
IF Cpos% < 1 THEN
Cpos% = 1
ELSEIF Cpos% > MaxLen% THEN
Cpos% = MaxLen%
END IF
IF Cpos% < Offset% THEN
Offset% = Cpos%
ELSEIF (Cpos% - Offset% + 2) > VisLen% THEN
Offset% = (Cpos% - VisLen% + 1)
IF Offset% > MaxOff% THEN Offset% = MaxOff%
END IF
GOSUB fInputPrint
LOCATE Row%, (Col% + Cpos% - Offset%), 1
KeyVal% = fGetKey%
IF (INSTR(Exet$, MKI$(KeyVal%)) AND 1) THEN EXIT DO
SELECT CASE KeyVal%
CASE 32 TO 255
IF (Inzert% = 0) OR (Cpos% = MaxLen%) THEN
MID$(Temp$, Cpos%, 1) = CHR$(KeyVal%)
ELSE
Temp$ = LEFT$(Temp$, Cpos% - 1) + CHR$(KeyVal%) + MID$(Temp$, Cpos%)
END IF
Cpos% = Cpos% + 1
CASE cBkSpcKey%
IF Cpos% > 1 THEN
Cpos% = Cpos% - 1
GOSUB fInputStrip
END IF
CASE cDelKey%
GOSUB fInputStrip
CASE cHomeKey%
Cpos% = 1
CASE cEndKey%
GOSUB fInputEOL
CASE cLeftKey%
Cpos% = Cpos% - 1
CASE cRightKey%
Cpos% = Cpos% + 1
CASE cInsKey%
Inzert% = (Inzert% XOR 31)
LOCATE , , , Inzert%, 31
END SELECT
LOOP
Offset% = 1
Temp$ = LTRIM$(Temp$)
IF KeyVal% <> cEscKey% THEN
Datum$ = LEFT$(Temp$, MaxLen%)
Datum$ = RTRIM$(Temp$)
ELSE
Temp$ = Datum$
END IF
COLOR Fgrnd%, Bgrnd%
GOSUB fInputPrint
fInput% = KeyVal%
EXIT FUNCTION
'-----------------------------------------------------------------
'------------- local routines
'-----------------------------------------------------------------
fInputPrint:
LOCATE Row%, Col%, 0
PRINT MID$(Temp$, Offset%, VisLen%);
RETURN
'-----------------------------------------------------------------
fInputStrip:
Temp$ = LEFT$(Temp$, Cpos% - 1) + MID$(Temp$, Cpos% + 1)
RETURN
'-----------------------------------------------------------------
fInputEOL:
FOR Cpos% = MaxLen% TO 1 STEP -1
IF ASC(MID$(Temp$, Cpos%)) <> 32 THEN EXIT FOR
NEXT
Cpos% = Cpos% + 1
RETURN
END FUNCTION