home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PBC22B.ZIP / PBC$BAS.ZIP / DINPUT.BAS < prev    next >
BASIC Source File  |  1993-03-26  |  3KB  |  111 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB GetKbd (Ins%, Caps%, Num%, ScrollLock%)
  8.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  9.    DECLARE SUB NumFormat (FormatSt$, Number#, Result$)
  10.    DECLARE SUB SetKbd (BYVAL Ins%, BYVAL Caps%, BYVAL Num%, BYVAL ScrollLock%)
  11.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  12.  
  13.    DECLARE SUB GetSInput00 (FillCh%, ExitMode%, BadBeep%, FullBeep%, Fast%)
  14.    DECLARE SUB GetSInput01 (CurPosn%, FullExit%)
  15.    DECLARE SUB GetSInput02 (Capitalize%, TabExit%)
  16.  
  17. SUB DInput (FormatSt$, St&, St$, MinusOk%, Attr%, ExitCode%)
  18.    GetSInput00 FillCh%, ExitMode%, BadBeep%, FullBeep%, Fast%
  19.    GetSInput01 CurPosn%, FullExit%
  20.    GetSInput02 Capitalize%, TabExit%
  21.  
  22.    ExitCode% = 0
  23.  
  24.    MaxLen% = LEN(FormatSt$)
  25.  
  26.    Row% = CSRLIN
  27.    Col% = POS(0)
  28.    GetVidMode BIOSMode%, ScreenWidth%, Page%
  29.    GetKbd Ins%, Caps%, Num%, ScrollLock%
  30.    SetKbd Ins%, Caps%, 1, ScrollLock%
  31.  
  32.    DO
  33.       NumFormat FormatSt$, CDBL(St& / 100#), St$
  34.       XQPrint St$, Row%, Col%, Attr%, Page%, Fast%
  35.       DO
  36.          SetKbd Ins%, Caps%, 1, ScrollLock%
  37.          ky$ = INKEY$
  38.       LOOP UNTIL LEN(ky$)
  39.       IF LEN(ky$) = 2 THEN
  40.          GOSUB ExtendedKeys
  41.       ELSEIF ky$ < " " THEN
  42.          GOSUB ControlKeys
  43.       ELSE
  44.          GOSUB NormalKeys
  45.       END IF
  46.    LOOP UNTIL ExitCode%
  47.  
  48.    NumFormat FormatSt$, CDBL(St& / 100#), St$
  49.    XQPrint St$, Row%, Col%, Attr%, Page%, Fast%
  50.    SetKbd Ins%, Caps%, Num%, ScrollLock%
  51.    EXIT SUB
  52.  
  53. ' ------------ subroutines ----------------------------------------------------
  54.  
  55. ControlKeys:
  56.    SELECT CASE ASC(ky$)
  57.       CASE 3   ' ctrl C
  58.          IF ExitMode% THEN ExitCode% = -81
  59.       CASE 7, 8, 19   ' ctrl G, ctrl H, or ctrl S   (backspace)
  60.          tmp$ = LTRIM$(STR$(St&))
  61.          St& = CLNG(VAL(LEFT$(tmp$, LEN(tmp$) - 1)))
  62.       CASE 9   ' ctrl I (tab)
  63.          IF TabExit% THEN ExitCode% = 9
  64.       CASE 13  ' ctrl M (return)
  65.          ExitCode% = 13
  66.       CASE 18  ' ctrl R
  67.          IF ExitMode% THEN ExitCode% = -73
  68.       CASE 27  ' ctrl [ (esc)
  69.          ExitCode% = 27
  70.       CASE ELSE
  71.    END SELECT
  72.    RETURN
  73.  
  74. ExtendedKeys:
  75.    SELECT CASE ASC(RIGHT$(ky$, 1))
  76.       CASE 83   ' delete
  77.          tmp$ = LTRIM$(STR$(St&))
  78.          St& = CLNG(VAL(LEFT$(tmp$, LEN(tmp$) - 1)))
  79.       CASE ELSE
  80.          IF ExitMode% THEN ExitCode% = -ASC(RIGHT$(ky$, 1))
  81.    END SELECT
  82.    RETURN
  83.  
  84. NormalKeys:
  85.    IF INSTR("0123456789-", ky$) THEN
  86.       OldSt& = St&
  87.       IF ky$ = "-" THEN
  88.          IF MinusOk% THEN
  89.             St& = -St&
  90.          ELSE
  91.             IF BadBeep% THEN BEEP
  92.          END IF
  93.       ELSE
  94.          St& = CLNG(VAL(STR$(St&) + ky$))
  95.       END IF
  96.       IF OldSt& <> St& THEN
  97.          NumFormat FormatSt$, CDBL(St& / 100#), St$
  98.          IF LEN(St$) > MaxLen% THEN
  99.             IF FullBeep% THEN BEEP
  100.             St& = OldSt&
  101.          END IF
  102.       END IF
  103.    ELSEIF ky$ = "." THEN
  104.       tmp$ = LTRIM$(STR$(St&))
  105.       St& = CLNG(VAL(LEFT$(tmp$, LEN(tmp$) - 1)))
  106.    ELSE
  107.       IF BadBeep% THEN BEEP
  108.    END IF
  109.    RETURN
  110. END SUB
  111.