Unofficial FAQ 2.0 3/

 BBS: Inland Empire Archive
Date: 03-21-93 (12:53)             Number: 204
From: QUINN TYLER JACKSON          Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Unofficial FAQ 2.0    3/       Conf: (2) Quik_Bas

>>> Continued from previous message
                Color must be returned to what it was before the FUNCTION
                was called.  So must the previous cursor location.

                Some parameter to indicate if a direction arrow was pressed,
                or if ESC was pressed.

        Starting with this, we decide upon a name for this FUNCTION.
        Let's call it: FInput, for Field Input.

S1.0    FINPUT.BAS

' FAQ2.0 Sample code 1.0
' FINPUT.BAS
' Written by Quinn Tyler Jackson

CONST PressedEscape = -1
CONST PressedUpArrow = -2
CONST PressedDownArrow = -3

CONST TRUE = -1
CONST FALSE = NOT TRUE

' sample code here can be cut
COLOR 7, 0
CLS

Mask$ = "1234567890-+"
Default$ = "555-1212"

CLS
f$ = FInput(50, 1, 9, 0, 7, Mask$, Default$, p%)
LOCATE 5, 1
PRINT f$
' end of sample code

END

DEFINT A-Z
FUNCTION FInput$ (LenF, FRow, FCol, Fore, Back, Mask$, Default$, ErrorCode)

' This input routine has a few bugs in it in extreme circumstances, but
' it's good enough to show how to get the job done

IF Mask$ = "" THEN      ' If no mask, let anything through!
     FOR i = 0 TO 255
          Mask$ = Mask$ + CHR$(i)
     NEXT i
END IF

Buffer$ = Default$ + SPACE$(LenF - LEN(Default$))

' Save these for later restoration
OldFore = SCREEN(FRow, FCol, 1) MOD 16
OldBack = SCREEN(FRow, FCol, 1) \ 16
OldRow = CSRLIN
OldCol = POS(0)

COLOR Fore, Back

Ptr = LEN(Default$) + 1

DO                       ' This loop empties the keyboard
LOOP UNTIL INKEY$ = ""   ' buffer to avoid bad carry-over

DO
DO
     LOCATE FRow, FCol
     PRINT Buffer$
     IF Ptr <= LenF THEN
          LOCATE FRow, FCol + Ptr - 1
          PRINT "_"
     END IF
     char$ = INKEY$
LOOP UNTIL char$ <> ""

SELECT CASE LEN(char$)
CASE 1
     SELECT CASE ASC(char$)
          CASE 8    ' Delete key
               IF Ptr > 1 THEN
                    Ptr = Ptr - 1
               END IF
               Buffer$ = LEFT$(Buffer$, Ptr - 1) + MID$(Buffer$, Ptr + 1)
          CASE 13   ' ENTER was pressed
               ErrorCode = 0
               FInput$ = RTRIM$(Buffer$)
               EXIT DO
          CASE 27   ' ESCAPE key was pressed
               ErrorCode = PressedESC
               FInput$ = ""
               LOCATE FRow, FCol
               PRINT SPACE$(LenF)
               EXIT DO
          CASE ELSE ' some other key was pressed
               IF INSTR(Mask$, char$) THEN
                    MID$(Buffer$, Ptr, 1) = char$
                    IF Ptr < LenF THEN
                         Ptr = Ptr + 1
                    ELSE
                         BEEP
                    END IF
               ELSE
                    BEEP
               END IF
     END SELECT
CASE 2
     scan = ASC(RIGHT$(char$, 1))
     SELECT CASE scan
          CASE 83   ' delete key pad
               InsertMode = FALSE
          CASE 84   ' insert key pad
               InsertMode = TRUE
          CASE 80   ' down arrow
               ErrorCode = PressedDownArrow
               FInput$ = RTRIM$(Buffer$)
               EXIT DO
          CASE 79   ' END key
               Ptr = LenF
          CASE 77   ' right arrow
               IF Ptr < LenF THEN
               Ptr = Ptr + 1
               ELSE
                    BEEP
               END IF
          CASE 75   ' left arrow
               IF Ptr > 1 THEN
                    Ptr = Ptr - 1
               ELSE
                    BEEP
               END IF
          CASE 72   ' up arrow
               ErrorCode = PressedUpArrow
               FInput$ = RTRIM$(Buffer$)
               EXIT DO
          CASE 71   ' HOME Key
               Ptr = 1
     END SELECT
END SELECT

LOOP UNTIL char$ = CHR$(13)

LOCATE FRow, FCol
PRINT Buffer$
LOCATE OldRow, OldCol
COLOR OldFore, OldBack
END FUNCTION
>>> Continued to next message