Download code

Jump to: navigation, search

Back to Input_formatting_(QBASIC)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

InpUsing.bas

  1 REM The authors of this work have released all rights to it and placed it
  2 REM in the public domain under the Creative Commons CC0 1.0 waiver
  3 REM (http://creativecommons.org/publicdomain/zero/1.0/).
  4 REM 
  5 REM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  6 REM EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  7 REM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  8 REM IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  9 REM CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 10 REM TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 11 REM SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 12 REM 
 13 REM Retrieved from: http://en.literateprograms.org/Input_formatting_(QBASIC)?oldid=11120
 14 
 15 DECLARE FUNCTION ValidInput$ (aMask AS STRING, aChecked AS STRING, aUnchecked AS STRING)
 16 DECLARE FUNCTION InputUsing$ (aMask AS STRING, aText AS STRING)
 17 
 18 DIM mStatus AS STRING
 19 DIM mTest AS STRING
 20 DIM mMask AS STRING
 21 DIM mChecked AS STRING
 22 DIM mUnchecked AS STRING
 23 DIM mExpected AS STRING
 24 DIM mGot AS STRING
 25 
 26 CLS
 27 RESTORE TestCases
 28 mStatus = ""
 29 DO WHILE mStatus = ""
 30    READ mTest
 31    IF mTest = "" THEN
 32       mStatus = "All tests Succeeded"
 33    ELSE
 34       READ mMask, mChecked, mUnchecked, mExpected
 35       mGot = ValidInput$(mMask, mChecked, mUnchecked)
 36       PRINT "'" + mMask + "' '" + mChecked + "'+'" + mUnchecked + "': '" + mGot + "'"
 37       IF mExpected <> mGot THEN
 38          mStatus = "Last test failed (Expected '" + mExpected + "')"
 39       END IF
 40    END IF
 41 LOOP
 42 PRINT mStatus
 43 SYSTEM
 44 
 45 TestCases:
 46    DATA "*","(000) 000-0000","","(401) 522-7946","(401) 522-7946"
 47    DATA "*","(000) 000-0000","","(401) 522 7946","(401) 522"
 48    DATA "*","A0A 0A0","D3Z 4Q","9","D3Z 4Q9"
 49    DATA ""
 50 FUNCTION InputUsing$ (aMask AS STRING, aText AS STRING)
 51 
 52    DIM dX AS INTEGER
 53    DIM dY AS INTEGER
 54    DIM dBuffer AS STRING
 55    DIM dNewChar AS STRING
 56 
 57    LET dBuffer = ValidInput$(aMask, "", aText)
 58    LET dX = POS(0)
 59    LET dY = CSRLIN
 60    LOCATE dY, dX
 61    PRINT dBuffer; SPACE$(LEN(aMask) - LEN(dBuffer));
 62    LOCATE dY, dX, 1
 63    DO
 64       LET dNewChar = INKEY$
 65       SELECT CASE LEN(dNewChar)
 66       CASE 0
 67          REM No character typed so do nothing
 68       CASE 1
 69          SELECT CASE ASC(dNewChar)
 70          CASE 8
 71             LET dNewChar = ""
 72             IF LEN(dBuffer) > 0 THEN
 73                LET dBuffer = LEFT$(dBuffer, LEN(dBuffer) - 1)
 74             END IF
 75          CASE 13
 76             LET dNewChar = ""
 77             PRINT
 78             IF LEN(dBuffer) = LEN(aMask) THEN
 79                EXIT DO
 80             END IF
 81          CASE 27
 82             LET dBuffer = aText
 83             LET dNewChar = ""
 84             PRINT
 85             EXIT DO
 86          CASE ELSE
 87             LET dBuffer = ValidInput$(aMask, dBuffer, dNewChar)
 88          END SELECT
 89          LOCATE dY, dX
 90          PRINT dBuffer; SPACE$(LEN(aMask) - LEN(dBuffer));
 91          LOCATE dY, dX + LEN(dBuffer), 1
 92       CASE ELSE
 93          SELECT CASE ASC(MID$(dNewChar, 2, 1))
 94          CASE ELSE
 95             LET dNewChar = ""
 96          END SELECT
 97       END SELECT
 98    LOOP
 99 
100    LET InputUsing = dBuffer
101  
102 END FUNCTION
103 
104 FUNCTION ValidInput$ (aMask AS STRING, aChecked AS STRING, aUnchecked AS STRING)
105 
106    CONST cNumeric = "0123456789"
107    CONST cUpper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
108    CONST cLower = "abcdefghijklmnopqrstuvwxyz"
109    CONST cAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
110    CONST cAlphaNumeric = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
111 
112    DIM J AS INTEGER
113    DIM dBuffer AS STRING
114    DIM dChar AS STRING
115   
116    LET dBuffer = aChecked
117 
118    LET J = 1
119    DO WHILE J <= LEN(aUnchecked)
120       LET dChar = MID$(aUnchecked, J, 1)
121       SELECT CASE UCASE$(MID$(aMask, LEN(dBuffer) + 1, 1))
122       CASE "0"
123          IF INSTR(cNumeric, dChar) = 0 THEN
124             LET dChar = ""
125          END IF
126       CASE "U"
127          IF INSTR(cUpper, dChar) = 0 THEN
128             LET dChar = ""
129          END IF
130       CASE "L"
131          IF INSTR(cLower, dChar) = 0 THEN
132             LET dChar = ""
133          END IF
134       CASE "A"
135          IF INSTR(cAlpha, dChar) = 0 THEN
136             LET dChar = ""
137          END IF
138       CASE "X"
139          IF INSTR(cAlphaNumeric, dChar) = 0 THEN
140             LET dChar = ""
141          END IF
142       CASE "?"
143          REM Any character is okay so do nothing
144       CASE ELSE
145          IF MID$(aMask, LEN(dBuffer) + 1, 1) <> dChar THEN
146             LET dChar = ""
147          END IF
148       END SELECT
149       LET dBuffer = dBuffer + dChar
150       LET J = J + 1
151    LOOP
152   
153    LET ValidInput = dBuffer
154 
155 END FUNCTION
156 


hijacker
hijacker
hijacker
hijacker