Download text file
'------------------------------------------------------------------------
' fInput% function for PowerBASIC Console Compiler
' 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 CONSTANTS 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
'----------------------------------------------------------------------
' fInput%(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&
'--------------------------------------------------------------------------
%Esc_key = &h001B ' key codes returned by fGetKey%
%Enter_key = &h000D
%BkSpc_key = &h0008
%Del_key = &h5300
%Up_key = &h4800
%Down_key = &h5000
%Ins_key = &h5200
%Left_key = &h4B00
%Right_key = &h4D00
%Ctrl_Del = &h9300
%F10_key = &h4400
%Home_key = &h4700
%End_key = &h4F00
%Fgrnd = 15 ' editing foreground
%Bgrnd = 1 ' editing background
DECLARE FUNCTION fInput(SEG D AS STRING,BYVAL Row AS LONG,BYVAL Col AS LONG,BYVAL VisLen AS LONG,BYVAL MaxLen AS LONG,BYVAL ExitKeys AS STRING) AS INTEGER
DECLARE FUNCTION fGetKey() AS INTEGER
FUNCTION PBmain ()
DIM C AS LOCAL LONG
DIM Col AS LOCAL LONG
DIM D(5) AS LOCAL STRING
DIM ExitKeys AS LOCAL STRING
DIM F(2,5) AS LOCAL LONG
DIM Fld AS LOCAL LONG
DIM G AS LOCAL INTEGER
DIM Prompt AS LOCAL STRING
DIM X AS LOCAL LONG
COLOR 0, 15
CLS
D(0) = "Mary had a little lamb, its fleece was white as snow."
G = fInput(D(0), 2, 10, 20, 70, "")
LOCATE 2, 1: PRINT D(0);
FOR X = 1 TO 5
INCR C : Prompt = READ$(C)
INCR C : D(X) = READ$(C)
INCR C : F(0,X) = VAL(READ$(C))
INCR C : F(1,X) = VAL(READ$(C))
INCR C : F(2,X) = VAL(READ$(C))
Col = F(1,X) - LEN(Prompt) - 1
COLOR 8, 15
LOCATE F(0,X), Col
PRINT Prompt;
COLOR 1, 15
LOCATE F(0,X), F(1,X)
PRINT LEFT$(D(X), F(2,X))
NEXT
LOCATE 25, 1
PRINT "Use Arrows to move - F-10 to save & exit - to quit";
ExitKeys = MKI$(%F10_key) + MKI$(%Up_Key) + MKI$(%Down_Key)
Fld = 1
DO
IF Fld < 1 THEN
Fld = 5
ELSEIF Fld > 5 THEN
Fld = 1
END IF
G = fInput( D(Fld), F(0,Fld), F(1,Fld), 0, F(2,Fld), ExitKeys)
SELECT CASE G
CASE %F10_key : EXIT LOOP
CASE %Esc_Key : EXIT LOOP
CASE %Up_Key : DECR Fld
CASE ELSE : INCR Fld
END SELECT
LOOP
FOR X = 1 TO 5
LOCATE X + 10, 1
PRINT D(X)
NEXT
WAITKEY$
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
END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fGetKey () EXPORT AS INTEGER
DIM G AS LOCAL STRING
G = WAITKEY$
IF LEN(G) = 1 THEN
FUNCTION = ASC(G)
ELSE
FUNCTION = CVI(G)
END IF
END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fInput ( SEG Datum AS STRING, _
BYVAL Row AS LONG , _
BYVAL Col AS LONG , _
BYVAL VisLen AS LONG , _
BYVAL MaxLen AS LONG , _
BYVAL ExitKeys AS STRING ) EXPORT AS INTEGER
DIM Bgrnd AS LOCAL LONG ' original background color
DIM Cpos AS LOCAL LONG ' current cursor position within string
DIM E AS LOCAL LONG ' temp variable
DIM Fgrnd AS LOCAL LONG ' original foreground color
DIM Inzert AS LOCAL LONG ' insert state
DIM KeyVal AS LOCAL LONG ' incoming key-press value
DIM MaxOff AS LOCAL LONG ' maximum offset position
DIM Offset AS LOCAL LONG ' 1st character shown in field
DIM Temp AS LOCAL STRING * 256 ' working data string
Temp = LTRIM$(Datum)
Inzert = 10
ExitKeys = MKI$(%ESC_key) & MKI$(%Enter_Key) & ExitKeys$
Bgrnd = SCREENATTR(Row, Col)
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 %Fgrnd, %Bgrnd
CURSOR ON, Inzert
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 = MIN(MaxOff,(Cpos - VisLen + 1))
END IF
GOSUB fInputPrint
LOCATE Row, (Col + Cpos - Offset)
KeyVal = fGetKey
E = INSTR(ExitKeys, MKI$(KeyVal))
IF (E AND 1) = 1 THEN EXIT LOOP
SELECT CASE KeyVal
CASE 32 TO 255 : IF (Inzert > 10) OR (Cpos = MaxLen) THEN
ASC(Temp,Cpos) = KeyVal
ELSE
Temp = STRINSERT$(Temp,CHR$(KeyVal),Cpos)
END IF
INCR Cpos
CASE %BkSpc_Key : IF Cpos > 1 THEN
DECR Cpos
Temp = STRDELETE$(Temp,Cpos,1)
END IF
CASE %Del_Key : Temp = STRDELETE$(Temp,Cpos,1)
CASE %Home_Key : Cpos = 1
CASE %End_Key : GOSUB fInputEOL
CASE %Left_Key : DECR Cpos
CASE %Right_Key : INCR Cpos
CASE %Ins_Key : IF Inzert = 10 THEN Inzert = 50 ELSE Inzert = 10
CURSOR ON, Inzert
END SELECT
LOOP
Offset = 1
IF KeyVal <> %Esc_Key THEN Datum = TRIM$(Temp)
Temp = Datum
COLOR Fgrnd, Bgrnd
GOSUB fInputPrint
FUNCTION = KeyVal
EXIT FUNCTION
'-----------------------------------------------------------------
'------------- local routines
'-----------------------------------------------------------------
fInputPrint:
LOCATE Row, Col
PRINT MID$(Temp, Offset, VisLen);
RETURN
'-----------------------------------------------------------------
fInputEOL:
FOR Cpos = MaxLen TO 1 STEP -1
IF ASC(Temp, Cpos) <> 32 THEN EXIT FOR
NEXT
INCR Cpos
RETURN
END FUNCTION