'===========================================================================
' Subject: MASKED INPUT ROUTINES FOR QB       Date: 02-16-98 (20:18)       
'  Author: Trevor C. Osborne                  Code: QB, QBasic, PDS        
'  Origin: av296@chebucto.ns.ca             Packet: TEXT.ABC
'===========================================================================
'============================================================================
'Qbasic/QB Input Routines v1.0 by Trevor Osborne (av296@chebucto.ns.ca)
'---------------------------------------------------------------------------
'I originaly wrote these routines for a BBS software I am writting but they
'can be usefull in other applictions too, feel free to use them in your
'programs, I don't ask that you give me credit in your programs, but it would
'be nice.  You can change what ever you want, and if you think you've
'improved on my source let me know!
'============================================================================

DECLARE SUB InptPostalCode (Text$, x, y, Fore, Back)
DECLARE SUB InptDate (Text$, x, y, Fore, Back)
DECLARE SUB Inpt (Text$, Length, x, y, Fore, Back, Char$)
DECLARE SUB InptPhone (Text$, x, y, Fore, Back)
DECLARE SUB InptNum (Num, Length, x, y, Fore, Back)

'I think the syntax of the subs is pretty self explainatory so I'll skip
'by them

CLS
COLOR 7, 0

PRINT "Set length input..."
Inpt Var1$, 10, 3, 1, 7, 1, ""
PRINT 'a print after to skip to the next line

PRINT "Set length protected input"
Inpt Var2$, 10, 5, 1, 7, 1, "þ"
PRINT

PRINT "Integer input..."
InptNum Var3, 4, 7, 1, 7, 1
PRINT

PRINT "Phone number input..."
InptPhone Var4$, 9, 1, 7, 1
PRINT

PRINT "Date input..."
InptDate Var5$, 11, 1, 7, 1
PRINT

PRINT "Postal code input..."
InptPostalCode Var6$, 13, 1, 7, 1
PRINT

PRINT "Set length input /w previously defined variable..."
Var7$ = "Some Text"
Inpt Var7$, 10, 15, 1, 7, 1, ""
PRINT

PRINT "That's all folks!"

SUB Inpt (Text$, Length, x, y, Fore, Back, Mask$)

OldText$ = Text$ 'In case the var was defined and the user pressed ESC

GOSUB RedrawInpt '<-- Draw the input box on the screen

InptLoop: '<-- So I can return to the input loop after the user reaches
	  '    the max length and presses backspace

DO '<-- Main input loop, reads all the keys pressed

 IF LEN(Text$) = Length THEN GOSUB InptLimit '<-- if it's the max length
					     '<-- then don't add anymore
					     '<-- to the string
 DO '<-- Wait for the user to press a key
  a$ = INKEY$
 LOOP UNTIL a$ > "" '<-- if the user pressed a key process it

 SELECT CASE a$

  CASE CHR$(9) '<-- Tab key causes problems with the display, gotta trap it
   GOSUB RedrawInpt

  CASE CHR$(8) '<-- Back space key
   IF LEN(Text$) = 0 THEN GOSUB InptLoop
   a = LEN(Text$) - 1
   Text$ = LEFT$(Text$, a)
   GOSUB RedrawInpt

  CASE CHR$(27) '<-- Escape key
   Text$ = OldText$ '<-- if it was defined before the call change it back
   EXIT SUB

  CASE CHR$(13) '<-- Enter key, all done!
   EXIT SUB

  CASE ELSE '<-- if it's anything else add it to the string
   Text$ = Text$ + a$
   GOSUB RedrawInpt

 END SELECT
LOOP


RedrawInpt: '<-- where all the screen out put takes place
COLOR Fore, Back
LOCATE x, y, 1
PRINT SPACE$(Length);
LOCATE x, y, 1
IF Mask$ <> "" THEN '<-- If you want protected input
 PRINT STRING$(LEN(Text$), ASC(Mask$));
ELSE '<-- or else print the acctual string
 PRINT Text$;
END IF
COLOR 7, 0 '<-- just so you don't end up with weird colors after the call
RETURN

InptLimit: '<-- max len of the string is reached, loop until enter, esc, or
DO         '    backspace is pressed
 DO '<-- loop until a key is pressed
  b$ = INKEY$
 LOOP UNTIL b$ > ""

 IF b$ = CHR$(8) THEN Text$ = LEFT$(Text$, Length - 1): GOSUB RedrawInpt: GOSUB InptLoop
 IF b$ = CHR$(13) THEN EXIT DO
 IF b$ = CHR$(27) THEN Text$ = OldText$: EXIT DO

LOOP

END SUB

SUB InptDate (Text$, x, y, Fore, Back)

OldText$ = Text$

GOSUB RedrawInptDate

InptDateLoop:

DO

 IF LEN(Text$) = 8 THEN GOSUB InptDateLimit

 a$ = INKEY$
 SELECT CASE a$

  CASE CHR$(8) '<-- Backspace key
   IF LEN(Text$) = 0 THEN GOSUB InptDateLoop '<-- this is just to control
   IF LEN(Text$) = 1 THEN Text$ = ""         '    where a char is placed  
   IF LEN(Text$) = 2 THEN a = 1              '    when a key is pressed  
   IF LEN(Text$) = 3 THEN a = 2
   IF LEN(Text$) = 4 THEN a = 2
   IF LEN(Text$) = 5 THEN a = 4
   IF LEN(Text$) = 6 THEN a = 4
   IF LEN(Text$) = 7 THEN a = 6
   IF LEN(Text$) = 8 THEN a = 7
  
   Text$ = LEFT$(Text$, a)
   GOSUB RedrawInptDate

  CASE CHR$(27)
   Text$ = OldText$
   EXIT SUB

  CASE IS > CHR$(47) '<-- to only allow numbers
   IF a$ > CHR$(57) THEN GOSUB InptDateLoop
   IF LEN(Text$) = 2 THEN Text$ = Text$ + "/"  '<-- adds the "/"'s
   IF LEN(Text$) = 5 THEN Text$ = Text$ + "/"
   Text$ = Text$ + a$
   GOSUB RedrawInptDate '<-- Gotta redraw it, it's changed

 END SELECT
LOOP

RedrawInptDate:
COLOR Fore, Back
LOCATE x, y, 1: PRINT "  /  /  ";
LOCATE x, y, 1: PRINT Text$;
COLOR 7, 0
RETURN

InptDateLimit:
DO
 DO
  b$ = INKEY$

 LOOP UNTIL b$ > ""

 IF b$ = CHR$(8) THEN Text$ = LEFT$(Text$, 7): GOSUB RedrawInptDate: GOSUB InptDateLoop
 IF b$ = CHR$(13) THEN EXIT DO
 IF b$ = CHR$(27) THEN Text$ = OldText$: EXIT DO

LOOP

END SUB

SUB InptNum (Num, Length, x, y, Fore, Back)

'In the input routine the var is handled as a string, it's just easier
'it's retruned as a integer though

Text$ = LTRIM$(RTRIM$(STR$(Num)))
IF Num = 0 THEN Text$ = ""
OldText$ = Text$

GOSUB RedrawInptNum

InptNumLoop:

DO
	       
 IF LEN(Text$) = Length THEN GOSUB InptNumLimit

 a$ = INKEY$

 SELECT CASE a$

  CASE CHR$(8)
   IF LEN(Text$) = 0 THEN GOSUB InptNumLoop
   a = LEN(Text$) - 1
   Text$ = LEFT$(Text$, a)
   GOSUB RedrawInptNum

  CASE CHR$(27)
   Text$ = OldText$
   Num = VAL(Text$)
   EXIT SUB

  CASE CHR$(13)
   EXIT SUB

  CASE IS > CHR$(47)
   IF a$ > CHR$(57) THEN GOSUB InptNumLoop
   Text$ = Text$ + a$
   GOSUB RedrawInptNum

 END SELECT
LOOP


RedrawInptNum:
COLOR Fore, Back
LOCATE x, y, 1: PRINT SPACE$(Length)
LOCATE x, y, 1: PRINT Text$;
COLOR 7, 0
RETURN

InptNumLimit:
DO
 DO
  b$ = INKEY$
 LOOP UNTIL b$ > ""

 IF b$ = CHR$(8) THEN Text$ = LEFT$(Text$, Length - 1): GOSUB RedrawInptNum: GOSUB InptNumLoop
 IF b$ = CHR$(13) THEN Num = VAL(Text$): EXIT DO
 IF b$ = CHR$(27) THEN Text$ = OldText$: Num = VAL(Text$): EXIT DO

LOOP

END SUB

SUB InptPhone (Text$, x, y, Fore, Back)

COLOR Fore, Back
OldText$ = Text$
GOSUB RedrawInptPhone

InptPhoneLoop:

DO

 IF LEN(Text$) = 13 THEN GOSUB InptPhoneLimit
 IF LEN(Text$) = 0 THEN Text$ = Text$ + "("

 a$ = INKEY$
 SELECT CASE a$

  CASE CHR$(8)
  
   IF LEN(Text$) = 1 THEN GOSUB InptPhoneLoop '<-- handles the position
   IF LEN(Text$) = 2 THEN a = 1               '    needed to handle the 
   IF LEN(Text$) = 3 THEN a = 2               '    brackets and the dash 
   IF LEN(Text$) = 4 THEN a = 3
   IF LEN(Text$) = 5 THEN a = 3
   IF LEN(Text$) = 6 THEN a = 5
   IF LEN(Text$) = 7 THEN a = 6
   IF LEN(Text$) = 8 THEN a = 7
   IF LEN(Text$) = 10 THEN a = 8
   IF LEN(Text$) = 11 THEN a = 10
   IF LEN(Text$) = 12 THEN a = 11
  
   Text$ = LEFT$(Text$, a)
   GOSUB RedrawInptPhone

  CASE CHR$(27)
   Text$ = OldText$
   EXIT SUB

  CASE IS > CHR$(47) '<-- only #'s allowed, no hotlines here ;)
   IF a$ > CHR$(57) THEN GOSUB InptPhoneLoop
   IF LEN(Text$) = 0 THEN Text$ = Text$ + "("
   IF LEN(Text$) = 4 THEN Text$ = Text$ + ")"
   IF LEN(Text$) = 8 THEN Text$ = Text$ + "-"
   Text$ = Text$ + a$
   GOSUB RedrawInptPhone

 END SELECT
LOOP

RedrawInptPhone:
COLOR Fore, Back
LOCATE x, y, 1: PRINT "(   )   -    ";
LOCATE x, y, 1: PRINT Text$;
COLOR 7, 0
RETURN

InptPhoneLimit:
DO
 DO
  b$ = INKEY$
 LOOP UNTIL b$ > ""

 IF b$ = CHR$(8) THEN Text$ = LEFT$(Text$, 12): GOSUB RedrawInptPhone: GOSUB InptPhoneLoop
 IF b$ = CHR$(13) THEN LOCATE , , 0: EXIT DO
 IF b$ = CHR$(27) THEN Text$ = OldText$: LOCATE , , 0: EXIT DO

LOOP

END SUB

SUB InptPostalCode (Text$, x, y, Fore, Back)

'you should know enough now that I don't have to comment it.  All the
'routines are similar

OldText$ = Text$

GOSUB RedrawInptPostalCode

InptPostalCodeLoop:

DO

 IF LEN(Text$) = 7 THEN GOSUB InptPostalCodeLimit

 a$ = INKEY$
 a$ = UCASE$(a$)
 SELECT CASE a$

  CASE CHR$(8)
   IF LEN(Text$) = 0 THEN GOSUB InptPostalCodeLoop
   IF LEN(Text$) = 1 THEN Text$ = ""
   IF LEN(Text$) = 2 THEN a = 1
   IF LEN(Text$) = 3 THEN a = 2
   IF LEN(Text$) = 4 THEN a = 3
   IF LEN(Text$) = 5 THEN a = 3
   IF LEN(Text$) = 6 THEN a = 5
   IF LEN(Text$) = 7 THEN a = 6
  
   Text$ = LEFT$(Text$, a)
   GOSUB RedrawInptPostalCode

  CASE CHR$(27)
   Text$ = OldText$
   EXIT SUB

   CASE IS > CHR$(46)
    IF LEN(Text$) = 3 THEN Text$ = Text$ + "-"
    IF LEN(Text$) = 1 AND a$ > CHR$(47) AND a$ < CHR$(58) THEN Text$ = Text$ + a$
    IF LEN(Text$) = 4 AND a$ > CHR$(47) AND a$ < CHR$(58) THEN Text$ = Text$ + a$
    IF LEN(Text$) = 6 AND a$ > CHR$(47) AND a$ < CHR$(58) THEN Text$ = Text$ + a$
    IF LEN(Text$) = 0 AND a$ > CHR$(65) AND a$ < CHR$(90) THEN Text$ = Text$ + a$
    IF LEN(Text$) = 2 AND a$ > CHR$(65) AND a$ < CHR$(90) THEN Text$ = Text$ + a$
    IF LEN(Text$) = 5 AND a$ > CHR$(65) AND a$ < CHR$(90) THEN Text$ = Text$ + a$
    GOSUB RedrawInptPostalCode

 END SELECT
LOOP

RedrawInptPostalCode:
COLOR Fore, Back
LOCATE x, y, 1: PRINT "   -   ";
LOCATE x, y, 1: PRINT Text$;
COLOR 7, 0
RETURN

InptPostalCodeLimit:
DO
 DO
  b$ = INKEY$

 LOOP UNTIL b$ > ""

 IF b$ = CHR$(8) THEN Text$ = LEFT$(Text$, 6): GOSUB RedrawInptPostalCode: GOSUB InptPostalCodeLoop
 IF b$ = CHR$(13) THEN EXIT DO
 IF b$ = CHR$(27) THEN Text$ = OldText$: EXIT DO

LOOP

END SUB