Category : BASIC Source Code
Archive   : GETINTGR.ZIP
Filename : GETINTGR.BAS

'*****************************************************************************
'This sub will retrieve all numerical characters pressed up to the
'pressing of the ENTER key and will reject any non-numerical characters
'UNLESS they are allowed by calling with them in int$
'
'By Jerry Jackson, Orlando Fl.
'This as with any source code I release, is free for public use without
'obligation
'
'I decided that my end-user prompting for data input needed some nice
'touch. I have seen too many basic programs that are crying for more
'input routines like this.
'
'**Remember, your blinking cursor can be any displayable ascii character.**
'
'
'Calling Variables used: int$ - any additional allowable characters
' cursor$ - the blinking cursor character
' length% - the maximum number of numerical
' characters to get including any
' characters specified as allowable.
' row% - row at which to print
' col% - column at which to print
' fg% - foreground color
' bg% - background color
'
'
' Audible key click: Call with "length%" as negative integer to enable
'
' With audible key click enabled you'll get:
' legal keypress - one quick high pitch beep
' illegal keypress - low pitch error tone
' input field full - high pitch error tone
'
'
' Note: If you want to allow zero as the first character, then specify
' it in int$ when you call this routine. Otherwise a leading
' zero will not be permitted.
'
'
'Return Variables used: int$ - the string representation of number
'
'
'*****************************************************************************
'
SUB GetInteger (int$, cursor$, length%, row%, col%, fg%, bg%)


'un-comment these equates if they are not defined in your main module

' BACKSPACE = 8
' LEFTARROW = 19200


click% = 0
IF length% < 0 THEN click% = 1

length% = ABS(length%)


'if row or col not specified, then use current cursor position information

IF row% = 0 THEN row% = CSRLIN
IF col% = 0 THEN col% = POS(1)

'set up a visible prompt area

LOCATE row%, col%
COLOR fg%, bg%
PRINT STRING$(length%, 32);

'define the acceptable characters
'you can call with int$ = "." for example if you are allowing decimal points
'or int$ = "-" might be nice for phone numbers.

accept$ = "1234567890" + int$ 'numerical characters + additional allowed


'if called with a "0" in int$ then set starting zero flag to yes

IF INSTR(int$, "0") THEN allowzero% = 1


'reset int$ to null to be reused on return from sub

int$ = ""

'main loop that builds the integer$ while rejecting non-allowable characters

DO

nozerofirst:


IF LEN(integer$) = 0 THEN 'if nothing yet,
LOCATE row%, col% 'then display a blinking
COLOR fg% + 16, bg% 'cursor character defined
PRINT cursor$; 'as called in cursor$
COLOR fg%, bg%
END IF

a$ = INKEY$


IF a$ = CHR$(13) THEN
int$ = integer$

amounttoadd% = length% - LEN(int$) 'get rid of prompt before
LOCATE row%, col% 'returning to caller
PRINT int$; SPACE$(amounttoadd%);

EXIT SUB
END IF

SELECT CASE CVI(a$ + STRING$(2, 0))
CASE BACKSPACE, LEFTARROW
IF LEN(integer$) > 0 THEN
integer$ = LEFT$(integer$, LEN(integer$) - 1)
END IF
repad% = length% - (LEN(integer$) + LEN(cursor$))
LOCATE row%, col%
PRINT integer$; : COLOR fg% + 16: PRINT cursor$; : COLOR fg%: PRINT STRING$(repad%, 32);
END SELECT


IF a$ > "" THEN 'make sure a key is pressed

IF click% THEN
IF LEN(integer$) = length% THEN
PLAY "t255 o3 g64o2c64o4g64o2c64o4g64o2c64"
GOTO noprompt
END IF


'check for illegal characters, but allow backspace and leftarrow
IF INSTR(accept$, a$) OR a$ = CHR$(8) OR CVI(a$ + STRING$(2, 0)) = 19200 THEN GOTO c1 'check to see if a valid key, if so....

'play illegal character song
PLAY "t255 o0 g32o2c32o0g32o2c32o0g32"
GOTO noprompt


c1:
PLAY "t170 o5 c64"
END IF

IF INSTR(accept$, a$) THEN 'check to see if a valid key, if so....
IF LEN(integer$) < length% THEN 'check total string length thus far
IF LEN(integer$) = 0 AND a$ = "0" AND allowzero% = 0 THEN GOTO nozerofirst
integer$ = integer$ + a$
LOCATE row%, col%
PRINT integer$;
SELECT CASE LEN(integer$)
CASE IS = length%
GOTO noprompt
CASE IS < length%
COLOR fg% + 16: PRINT cursor$; : COLOR fg%
CASE ELSE
END SELECT

noprompt:

END IF
END IF
END IF

LOOP

END SUB