home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / baswiz19 / examples / winput.bas < prev    next >
Encoding:
BASIC Source File  |  1993-01-29  |  5.4 KB  |  160 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE SUB WCursor (BYVAL Handle%, BYVAL CSize%)
  10.    DECLARE SUB WGetCursor (BYVAL Handle%, CSize%)
  11.    DECLARE SUB WGetLocate (BYVAL Handle%, Row%, Column%)
  12.    DECLARE SUB WGetSize (BYVAL Handle%, Rows%, Columns%)
  13.    DECLARE SUB WGetView (BYVAL Handle%, Row%, Column%)
  14.    DECLARE SUB WGetVSize (BYVAL Handle%, Rows%, Columns%)
  15.    DECLARE SUB WGetTop (Handle%)
  16.    DECLARE SUB WLocate (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
  17.    DECLARE SUB WTop (BYVAL Handle%)
  18.    DECLARE SUB WUpdate ()
  19.    DECLARE SUB WView (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
  20.    DECLARE SUB WWrite (BYVAL Handle%, St$)
  21.  
  22.    DEFINT A-Z
  23.  
  24. SUB WInput (Handle, Valid$, ExitCode$, ExtExitCode$, MaxLength, St$, ExitKey$)
  25.    DEF SEG = 0
  26.    OldInsert = (PEEK(&H417) AND &H80)
  27.    WGetCursor Handle, OldCSize
  28.    WGetLocate Handle, StartRow, StartCol
  29.    WGetSize Handle, WinRows, WinCols
  30.    WGetVSize Handle, VirtRows, VirtCols
  31.    IF MaxLength > VirtCols - StartCol OR MaxLength < 1 THEN
  32.       MaxLen = VirtCols - StartCol
  33.    ELSE
  34.       MaxLen = MaxLength
  35.    END IF
  36.    IF MaxLen = 0 THEN EXIT SUB
  37.    St$ = LEFT$(St$, MaxLen)
  38.    InputCol = 0
  39.    ExitKey$ = ""
  40.    WGetTop TopHandle
  41.    IF Handle <> TopHandle THEN WTop Handle
  42.    WWrite Handle, St$
  43.    WLocate Handle, StartRow, StartCol
  44.    GOSUB InsureVisible
  45.    DO
  46.       DO
  47.          Ky$ = INKEY$
  48.       LOOP UNTIL LEN(Ky$)
  49.       SELECT CASE LEN(Ky$)
  50.          CASE 1: IF INSTR(ExitCode$, Ky$) THEN ExitKey$ = Ky$
  51.          CASE 2: IF INSTR(ExtExitCode$, RIGHT$(Ky$, 1)) THEN ExitKey$ = Ky$
  52.       END SELECT
  53.       IF LEN(ExitKey$) = 0 THEN
  54.          IF LEN(Ky$) = 2 THEN
  55.             SELECT CASE ASC(RIGHT$(Ky$, 1))
  56.                CASE 71: GOSUB ToStart                      ' move to line start
  57.                CASE 75: GOSUB LeftOnce                     ' left by one char
  58.                CASE 77: GOSUB RightOnce                    ' right by one char
  59.                CASE 79: GOSUB ToEnd                        ' move to line end
  60.                CASE 82: GOSUB InsureVisible                ' toggle insert mode
  61.                CASE 83: GOSUB DeleteChr                    ' delete char
  62.                CASE ELSE
  63.             END SELECT
  64.          ELSEIF Ky$ < " " THEN
  65.             SELECT CASE CHR$(ASC(Ky$) + 64)
  66.                CASE "D": GOSUB RightOnce                   ' right by one char
  67.                CASE "G": GOSUB DeleteChr                   ' delete char
  68.                CASE "H": GOSUB Backspace                   ' backspace
  69.                CASE "S": GOSUB LeftOnce                    ' left by one char
  70.                CASE "V": POKE &H417, PEEK(&H417) XOR &H80  ' toggle insert mode
  71.                          GOSUB InsureVisible
  72.                CASE ELSE
  73.             END SELECT
  74.          ELSEIF LEN(St$) < MaxLen THEN
  75.             IF LEN(Valid$) = 0 OR INSTR(Valid$, Ky$) > 0 THEN
  76.                IF PEEK(&H417) AND &H80 THEN
  77.                   St$ = LEFT$(St$, InputCol) + Ky$ + MID$(St$, InputCol + 1)
  78.                ELSEIF LEN(MID$(St$, InputCol + 1, 1)) THEN
  79.                   MID$(St$, InputCol + 1, 1) = Ky$
  80.                ELSE
  81.                   St$ = St$ + Ky$
  82.                END IF
  83.                WLocate Handle, StartRow, StartCol
  84.                WWrite Handle, St$
  85.                InputCol = InputCol + 1
  86.                WLocate Handle, StartRow, StartCol + InputCol
  87.                GOSUB InsureVisible
  88.             END IF
  89.          END IF
  90.          WUpdate
  91.       END IF
  92.    LOOP UNTIL LEN(ExitKey$)
  93.    WCursor Handle, OldCSize
  94.    WUpdate
  95.    POKE &H417, PEEK(&H417) AND &H7F OR OldInsert
  96.    EXIT SUB
  97.  
  98. InsureVisible:
  99.    WGetView Handle, WinRow, WinCol
  100.    IF StartCol + InputCol < WinCol THEN
  101.       WView Handle, WinRow, StartCol + InputCol
  102.    ELSEIF StartCol + InputCol > WinCol + WinCols - 1 THEN
  103.       WView Handle, WinRow, StartCol + InputCol - WinCols + 1
  104.    END IF
  105.    IF PEEK(&H417) AND &H80 THEN
  106.       WCursor Handle, 3
  107.    ELSE
  108.       WCursor Handle, 1
  109.    END IF
  110.    WUpdate
  111.    RETURN
  112.  
  113. LeftOnce:
  114.    IF InputCol THEN
  115.       InputCol = InputCol - 1
  116.       WLocate Handle, StartRow, StartCol + InputCol
  117.       GOSUB InsureVisible
  118.    END IF
  119.    RETURN
  120.  
  121. ToStart:
  122.    InputCol = 0
  123.    WLocate Handle, StartRow, StartCol
  124.    GOSUB InsureVisible
  125.    RETURN
  126.  
  127. RightOnce:
  128.    IF InputCol < LEN(St$) THEN
  129.       InputCol = InputCol + 1
  130.       WLocate Handle, StartRow, StartCol + InputCol
  131.       GOSUB InsureVisible
  132.    END IF
  133.    RETURN
  134.  
  135. ToEnd:
  136.    InputCol = LEN(St$)
  137.    WLocate Handle, StartRow, StartCol + InputCol
  138.    GOSUB InsureVisible
  139.    RETURN
  140.  
  141. Backspace:
  142.    IF InputCol THEN
  143.       InputCol = InputCol - 1
  144.       WLocate Handle, StartRow, StartCol + InputCol
  145.       GOSUB DeleteChr
  146.    END IF
  147.    RETURN
  148.  
  149. DeleteChr:
  150.    IF LEN(St$) THEN
  151.       St$ = LEFT$(St$, InputCol) + MID$(St$, InputCol + 2)
  152.       WLocate Handle, StartRow, StartCol
  153.       WWrite Handle, St$ + " "
  154.       WLocate Handle, StartRow, StartCol + InputCol
  155.       GOSUB InsureVisible
  156.    END IF
  157.    RETURN
  158.  
  159. END SUB
  160.