home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PBC22B.ZIP / PBC$BAS.ZIP / SINPUT.BAS < prev    next >
BASIC Source File  |  1993-01-01  |  8KB  |  225 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
  8.    DECLARE SUB GetKbd (Ins%, Caps%, Num%, ScrollLock%)
  9.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  10.    DECLARE SUB SetKbd (BYVAL Ins%, BYVAL Caps%, BYVAL Num%, BYVAL ScrollLock%)
  11.    DECLARE SUB TInstr (St$, BYVAL ChrType%, Place%)
  12.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
  13.  
  14.    DECLARE SUB GetSInput00 (FillCh%, ExitMode%, BadBeep%, FullBeep%, Fast%)
  15.    DECLARE SUB GetSInput01 (CurPosn%, FullExit%)
  16.    DECLARE SUB GetSInput02 (Capitalize%, TabExit%)
  17.  
  18. SUB SInput (St$, SLen%, ValidTypes%, MustFill%, VAttr%, ExitCode%)
  19.    GetSInput00 FillCh%, ExitMode%, BadBeep%, FullBeep%, Fast%
  20.    GetSInput01 CurPosn%, FullExit%
  21.    GetSInput02 Capitalize%, TabExit%
  22.  
  23.    ExitCode% = 0
  24.  
  25.    MaxLen% = LEN(St$)
  26.    St$ = LEFT$(St$, SLen%)
  27.    IF CurPosn% = 0 OR CurPosn% > MaxLen% THEN
  28.       CurPosn% = LEN(St$) + 1
  29.    END IF
  30.  
  31.    Row% = CSRLIN
  32.    Col% = POS(0)
  33.    GetVidMode BIOSMode%, ScreenWidth%, Page%
  34.    GetKbd Ins%, Caps%, Num%, ScrollLock%
  35.    CursorInfo OldVisible%, OldStart%, OldEnd%, MaxEnd%
  36.    CEnd% = MaxEnd%
  37.    CStart% = MaxEnd% - 1 + Ins% * 2
  38.  
  39.    DO
  40.       XQPrint St$, Row%, Col%, VAttr%, Page%, Fast%
  41.       XQPrint STRING$(MaxLen% - LEN(St$), FillCh%), Row%, Col% + LEN(St$), VAttr%, Page%, Fast%
  42.       LOCATE Row%, Col% + CurPosn% - 1, -(CurPosn% <= MaxLen%), CStart%, CEnd%
  43.       DO
  44.          ky$ = INKEY$
  45.       LOOP UNTIL LEN(ky$)
  46.       IF CtrlQ% THEN
  47.          GOSUB ComboKeys
  48.       ELSEIF LEN(ky$) = 2 THEN
  49.          GOSUB ExtendedKeys
  50.       ELSEIF ky$ < " " THEN
  51.          GOSUB ControlKeys
  52.       ELSE
  53.          GOSUB NormalKeys
  54.       END IF
  55.    LOOP UNTIL ExitCode%
  56.  
  57.    XQPrint SPACE$(MaxLen% - LEN(St$)), Row%, Col% + LEN(St$), VAttr%, Page%, Fast%
  58.    LOCATE Row%, Col%, OldVisible%, OldStart%, OldEnd%
  59.    SLen% = LEN(St$)
  60.    St$ = St$ + SPACE$(MaxLen% - SLen%)
  61.    EXIT SUB
  62.  
  63. ' ------------ subroutines ----------------------------------------------------
  64.  
  65. ControlKeys:
  66.    SELECT CASE ASC(ky$)
  67.       CASE 1   ' ctrl A
  68.          IF CurPosn% <= MaxLen% THEN tmp% = CurPosn% ELSE tmp% = MaxLen%
  69.          IF tmp% > 1 THEN
  70.             DO
  71.                tmp% = tmp% - 1
  72.             LOOP UNTIL MID$(St$, tmp%, 1) <> " " OR tmp% = 1
  73.          END IF
  74.          DO UNTIL MID$(St$, tmp%, 1) = " " OR tmp% = 1
  75.             tmp% = tmp% - 1
  76.          LOOP
  77.          IF MID$(St$, tmp%, 1) = " " THEN tmp% = tmp% + 1
  78.          CurPosn% = tmp%
  79.       CASE 3   ' ctrl C
  80.          IF ExitMode% THEN ExitCode% = -81
  81.       CASE 4   ' ctrl D
  82.          IF CurPosn% <= MaxLen% THEN CurPosn% = CurPosn% + 1
  83.       CASE 6   ' ctrl F
  84.          IF CurPosn% <= MaxLen% THEN tmp% = CurPosn% ELSE tmp% = MaxLen%
  85.          DO UNTIL MID$(St$, tmp%, 1) = " " OR tmp% >= LEN(St$)
  86.             tmp% = tmp% + 1
  87.          LOOP
  88.          IF MID$(St$, tmp%, 1) <> " " AND tmp% < LEN(St$) THEN tmp% = tmp% + 1
  89.          DO UNTIL MID$(St$, tmp%, 1) <> " "
  90.             tmp% = tmp% + 1
  91.          LOOP
  92.          IF MID$(St$, tmp%, 1) = " " THEN tmp% = tmp% - 1
  93.          CurPosn% = tmp%
  94.       CASE 7   ' ctrl G
  95.          IF CurPosn% <= LEN(St$) THEN
  96.             St$ = LEFT$(St$, CurPosn% - 1) + MID$(St$, CurPosn% + 1)
  97.          END IF
  98.       CASE 8   ' ctrl H (backspace)
  99.          IF CurPosn% > 1 THEN
  100.             CurPosn% = CurPosn% - 1
  101.             IF CurPosn% <= LEN(St$) THEN
  102.                St$ = LEFT$(St$, CurPosn% - 1) + MID$(St$, CurPosn% + 1)
  103.             END IF
  104.          END IF
  105.       CASE 9   ' ctrl I (tab)
  106.          IF TabExit% AND NOT MustFill% THEN ExitCode% = 9
  107.       CASE 13  ' ctrl M (return)
  108.          IF MustFill% AND (LEN(St$) = MaxLen%) OR NOT MustFill% THEN ExitCode% = 13
  109.       CASE 17  ' ctrl Q
  110.          CtrlQ% = -1
  111.       CASE 18  ' ctrl R
  112.          IF ExitMode% THEN ExitCode% = -73
  113.       CASE 19  ' ctrl S
  114.          IF CurPosn% > 1 THEN CurPosn% = CurPosn% - 1
  115.       CASE 20  ' ctrl T
  116.          IF CurPosn% <= LEN(St$) THEN
  117.             IF MID$(St$, CurPosn%, 1) = " " THEN
  118.                DO WHILE MID$(St$, CurPosn%, 1) = " "
  119.                   St$ = LEFT$(St$, CurPosn% - 1) + MID$(St$, CurPosn% + 1)
  120.                LOOP
  121.             ELSE
  122.                DO UNTIL MID$(St$, CurPosn%, 1) = " " OR CurPosn% > LEN(St$)
  123.                   St$ = LEFT$(St$, CurPosn% - 1) + MID$(St$, CurPosn% + 1)
  124.                LOOP
  125.             END IF
  126.          END IF
  127.       CASE 22  ' ctrl V
  128.          GetKbd Ins%, Caps%, Num%, ScrollLock%
  129.          Ins% = NOT Ins%
  130.          SetKbd Ins%, Caps%, Num%, ScrollLock%
  131.          CStart% = MaxEnd% - 1 + Ins% * 2
  132.       CASE 27  ' ctrl [ (esc)
  133.          IF NOT MustFill% THEN ExitCode% = 27
  134.       CASE ELSE
  135.    END SELECT
  136.    RETURN
  137.  
  138. ComboKeys:
  139.    CtrlQ% = 0
  140.    SELECT CASE ASC(UCASE$(ky$))
  141.       CASE 3, 67    ' ctrl C, C
  142.          IF ExitMode% THEN ExitCode% = -118
  143.       CASE 4, 68    ' ctrl D, D
  144.          CurPosn% = LEN(St$) + 1
  145.       CASE 18, 82   ' ctrl R, R
  146.          IF ExitMode% THEN ExitCode% = -132
  147.       CASE 19, 83   ' ctrl S, S
  148.          CurPosn% = 1
  149.       CASE 25, 89   ' ctrl Y, Y
  150.          IF CurPosn% <= LEN(St$) THEN St$ = LEFT$(St$, CurPosn% - 1)
  151.       CASE ELSE
  152.    END SELECT
  153.    RETURN
  154.  
  155. ExtendedKeys:
  156.    CtrlQ% = 0
  157.    SELECT CASE ASC(RIGHT$(ky$, 1))
  158.       CASE 82   ' insert
  159.          GetKbd Ins%, Caps%, Num%, ScrollLock%
  160.          CStart% = MaxEnd% - 1 + Ins% * 2
  161.       CASE 83   ' delete
  162.          IF CurPosn% <= LEN(St$) THEN
  163.             St$ = LEFT$(St$, CurPosn% - 1) + MID$(St$, CurPosn% + 1)
  164.          END IF
  165.       CASE 75   ' left arrow
  166.          IF CurPosn% > 1 THEN CurPosn% = CurPosn% - 1
  167.       CASE 77   ' right arrow
  168.          IF CurPosn% <= MaxLen% THEN CurPosn% = CurPosn% + 1
  169.       CASE 71   ' home
  170.          CurPosn% = 1
  171.       CASE 79   ' end
  172.          CurPosn% = LEN(St$) + 1
  173.       CASE 115  ' ctrl left arrow
  174.          IF CurPosn% <= MaxLen% THEN tmp% = CurPosn% ELSE tmp% = MaxLen%
  175.          IF tmp% > 1 THEN
  176.             DO
  177.                tmp% = tmp% - 1
  178.             LOOP UNTIL MID$(St$, tmp%, 1) <> " " OR tmp% = 1
  179.          END IF
  180.          DO UNTIL MID$(St$, tmp%, 1) = " " OR tmp% = 1
  181.             tmp% = tmp% - 1
  182.          LOOP
  183.          IF MID$(St$, tmp%, 1) = " " THEN tmp% = tmp% + 1
  184.          CurPosn% = tmp%
  185.       CASE 116  ' ctrl right arrow
  186.          IF CurPosn% <= MaxLen% THEN tmp% = CurPosn% ELSE tmp% = MaxLen%
  187.          DO UNTIL MID$(St$, tmp%, 1) = " " OR tmp% >= LEN(St$)
  188.             tmp% = tmp% + 1
  189.          LOOP
  190.          IF MID$(St$, tmp%, 1) <> " " AND tmp% < LEN(St$) THEN tmp% = tmp% + 1
  191.          DO UNTIL MID$(St$, tmp%, 1) <> " "
  192.             tmp% = tmp% + 1
  193.          LOOP
  194.          IF MID$(St$, tmp%, 1) = " " THEN tmp% = tmp% - 1
  195.          CurPosn% = tmp%
  196.       CASE 117  ' ctrl end
  197.          IF CurPosn% <= LEN(St$) THEN St$ = LEFT$(St$, CurPosn% - 1)
  198.       CASE ELSE
  199.          IF ExitMode% THEN ExitCode% = -ASC(RIGHT$(ky$, 1))
  200.    END SELECT
  201.    RETURN
  202.  
  203. NormalKeys:
  204.    IF LEN(St$) = MaxLen% AND (Ins% OR NOT Ins% AND CurPosn% > MaxLen%) THEN
  205.       IF FullBeep% THEN BEEP
  206.       RETURN
  207.    END IF
  208.    TInstr ky$, ValidTypes%, Found%
  209.    IF Found% = 0 OR CurPosn% > MaxLen% THEN
  210.       IF BadBeep% THEN BEEP
  211.       RETURN
  212.    END IF
  213.    IF Capitalize% THEN ky$ = UCASE$(ky$)
  214.    IF CurPosn% > LEN(St$) THEN
  215.       St$ = St$ + SPACE$(CurPosn% - LEN(St$) - 1) + ky$
  216.    ELSEIF Ins% THEN
  217.       St$ = LEFT$(St$, CurPosn% - 1) + ky$ + MID$(St$, CurPosn%)
  218.    ELSE
  219.       MID$(St$, CurPosn%, 1) = ky$
  220.    END IF
  221.    CurPosn% = CurPosn% + 1
  222.    IF (LEN(St$) = MaxLen%) AND FullExit% THEN ExitCode% = 13
  223.    RETURN
  224. END SUB
  225.