home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / GINPUT.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-04  |  29.4 KB  |  907 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : GINPUT.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : GET INPUT SUBROUTINE
  9. '
  10. '****************************************************************************
  11. '  This program and those associated with it were written for use with Quick-
  12. '  Windows Advanced (Version 1.5+).  Possesion of this program entitles you
  13. '  to certain priviliges.  They are:
  14. '
  15. '     1. You may compile, use, or modify this program in any way you choose
  16. '        provided you do not sell or give away the source code to this prog-
  17. '        ram or any of it's companions to anyone for any reason.  You may,
  18. '        however, sell the resulting executable program as you see fit.
  19. '
  20. '     2. You may modify, enhance or change these programs as you see fit. I
  21. '        as that you keep a copy of the original code and that you notify
  22. '        me of any improvements you make.  I like to think that the code is
  23. '        bug free and cannot be improved upon, but I'm sure someone will
  24. '        find a way to make it better.  If it's you, I'm looking forward to
  25. '        seeing your changes.  I can be reached at:
  26. '
  27. '              Tim Beck                      Tim Beck (C/O Debbie Beck)
  28. '              19419 Franz Road              8030 Fairchild Avenue
  29. '              Houston, Texas  77084         Canoga Park, California 91306
  30. '              (713) 639-3079                (818) 998-0588
  31. '
  32. '     3. This code has been tested and re-tested in a variety of applications
  33. '        and although I have not found any bugs, doesn't mean none exist. So,
  34. '        this program along with it's companions comes with NO WARRANTY,
  35. '        either expressed or implied.  I'm sorry if there are problems, but
  36. '        I can't be responsible for your work.  I've tried to provide a safe
  37. '        and efficient programming enviroment and I hope you find it helpful
  38. '        for you.  I do, however, need to cover my butt!
  39. '
  40. '  I have enjoyed creating this library of programs and have found them to be
  41. '  a great time saver.  I hope you agree.
  42. '
  43. '                                                            Tim Beck //
  44. '
  45. '****************************************************************************
  46.    DECLARE FUNCTION Show$ (Show.String$, Show.Len%)
  47.    DECLARE SUB GET.INPUT (Row%, Col%, C.pos%, C.type%, AR.Flag%, C.Flag%, Blank%, I.Color%, Format$, Linp$, M.len%, E.Flag%, kb%)
  48.    DECLARE SUB GET.FORMAT (kb%, kb$, C.pos%, Format$, Pass%)
  49.    DECLARE SUB PRINT.CHARSTRING (Row%, Col%, FmtString$, I.Color%)
  50.  
  51.   '---------------------------------------------------------------------------
  52.   '   Row%, Col%  = Current Row and Column
  53.   '   C.pos%      = Cursor position within String
  54.   '   C.type%     = Cursor Type (0 = None, 1 = Single Line, 2 = Half Width, 3 = Full Height (Overwrite)
  55.   '   AR.Flag%    = Auto Return Flag (0 = No Auto Return, 1 = Auto Return Max Width)
  56.   '   C.Flag%     = Case Flag (0 = Upper & Lower, 1 = Upper Only)
  57.   '   Blank%      = Blank Input Flag (0 = Blank out incoming String, 1 = Leave String Alone)
  58.   '   I.Color%    = Color Flag% (0 = Use Current Colors, 1 = Use Input Colors)
  59.   '   Format$     = String Format (See Below)
  60.   '   Linp$       = Input / Output String
  61.   '   M.len%      = Maximum Length for Input
  62.   '   E.Flag%     = Error Flag (0 = OK, 1 = Error, 2 = Fatal Error or Time Out)
  63.   '   kb%         = Keyboard Scan Code
  64.   '
  65.   '   Format Codes:
  66.   '
  67.   '      161      = (! + 128), Any Symbol
  68.   '      163      = (# + 128), Non-Signed Integer
  69.   '      171      = (+ + 128), Signed Decimal
  70.   '      174      = (. + 128), Non-Signed Decimal
  71.   '      193      = (A + 128), Upper-Case Alpha
  72.   '      206      = (N + 128), Upper-Case AlphaNumeric
  73.   '      208      = (P + 128), Proper Case AlphaNumeric
  74.   '      216      = (X + 128), Upper-Case Any Character
  75.   '      218      = (Z + 128), Upper-Case Any Character, except Quote (")
  76.   '      225      = (a + 128), Any-Case Alpha
  77.   '      230      = (f + 128), FileName Characters
  78.   '      238      = (n + 128), Any-case AlphaNumeric
  79.   '      244      = (t + 128), Logical (TF)
  80.   '      248      = (x + 128), Any-case Any Character
  81.   '      249      = (y + 128), Logical (YN)
  82.   '      250      = (z + 128), Any-case Any Character, except Quote (")
  83.  
  84.    REM $INCLUDE: 'STDCOM.INC'
  85.  
  86.    TIMER ON     'Enables Event Trapping (Used to Count time in Module!)
  87.  
  88. '  ON ERROR GOTO ErrorTrap
  89.  
  90. ErrorTrap:
  91.  
  92. '  RESUME
  93.  
  94. SUB GET.FORMAT (kb%, kb$, C.pos%, Format$, Pass%) STATIC
  95.  
  96.    FALSE = 0
  97.    TRUE = NOT FALSE
  98.   
  99.    Pass% = TRUE
  100.  
  101.    F.Choices$ = CHR$(161) + CHR$(163) + CHR$(171) + CHR$(174) + CHR$(193)
  102.    F.Choices$ = F.Choices$ + CHR$(206) + CHR$(216) + CHR$(218) + CHR$(225)
  103.    F.Choices$ = F.Choices$ + CHR$(230) + CHR$(238) + CHR$(243) + CHR$(244)
  104.    F.Choices$ = F.Choices$ + CHR$(248) + CHR$(249) + CHR$(250) + CHR$(208)
  105.   
  106.    IF C.pos% > 1 THEN
  107.       IF ASC(MID$(Format$, C.pos%, 1)) < 128 AND ASC(MID$(Format$, C.pos% - 1, 1)) > 128 AND kb$ = MID$(Format$, C.pos% - 1, 1) THEN
  108.          Last.Char% = -1
  109.       ELSE
  110.          Last.Char% = 0
  111.       END IF
  112.    END IF
  113.   
  114.    IF INSTR("+-.,1234567890", kb$) = 0 AND ASC(MID$(Format$, C.pos%, 1)) = 171 THEN
  115.       IF Last.Char = 0 THEN
  116.          PRINT Bell$;
  117.       END IF
  118.       Pass% = FALSE
  119.    ELSEIF INSTR(".,1234567890", kb$) = 0 AND ASC(MID$(Format$, C.pos%, 1)) = 174 THEN
  120.       IF Last.Char = 0 THEN
  121.          PRINT Bell$;
  122.       END IF
  123.       Pass% = FALSE
  124.    ELSEIF INSTR(",1234567890", kb$) = 0 AND ASC(MID$(Format$, C.pos%, 1)) = 163 THEN
  125.       IF Last.Char = 0 THEN
  126.          PRINT Bell$;
  127.       END IF
  128.       Pass% = FALSE
  129.    ELSEIF INSTR("1234567890-ABCDEFGHIJKLMNOPQRSTUVWXYZ:\.", kb$) = 0 AND ASC(MID$(Format$, C.pos%, 1)) = 230 THEN
  130.       IF ASC(MID$(Format$, C.pos%, 1)) = 230 AND kb% >= 97 AND kb% <= 122 THEN
  131.          kb% = kb% - 32
  132.          kb$ = CHR$(kb%)
  133.       ELSEIF Last.Char = 0 THEN
  134.          PRINT Bell$;
  135.          Pass% = FALSE
  136.       ELSE
  137.          Pass% = FALSE
  138.       END IF
  139.    ELSEIF INSTR("TF", kb$) = 0 AND ASC(MID$(Format$, C.pos%, 1)) = 244 THEN
  140.       IF ASC(MID$(Format$, C.pos%, 1)) = 244 AND (kb$ = "t" OR kb$ = "f") THEN
  141.          kb% = kb% - 32
  142.          kb$ = CHR$(kb%)
  143.       ELSEIF Last.Char = 0 THEN
  144.          PRINT Bell$;
  145.          Pass% = FALSE
  146.       ELSE
  147.          Pass% = FALSE
  148.       END IF
  149.    ELSEIF INSTR("YN", kb$) = 0 AND ASC(MID$(Format$, C.pos%, 1)) = 249 THEN
  150.       IF ASC(MID$(Format$, C.pos%, 1)) = 249 AND (kb$ = "y" OR kb$ = "n") THEN
  151.          kb% = kb% - 32
  152.          kb$ = CHR$(kb%)
  153.       ELSEIF Last.Char = 0 THEN
  154.          PRINT Bell$;
  155.          Pass% = FALSE
  156.       ELSE
  157.          Pass% = FALSE
  158.       END IF
  159.    ELSEIF (ASC(MID$(Format$, C.pos%, 1)) = 225 OR ASC(MID$(Format$, C.pos%, 1)) = 193) THEN
  160.       IF INSTR(" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", kb$) = 0 THEN
  161.          IF Last.Char = 0 THEN
  162.             PRINT Bell$;
  163.          END IF
  164.          Pass% = FALSE
  165.       ELSEIF ASC(MID$(Format$, C.pos%, 1)) = 193 AND kb% >= 97 AND kb% <= 122 THEN
  166.          kb% = kb% - 32
  167.          kb$ = CHR$(kb%)
  168.       END IF
  169.    ELSEIF (ASC(MID$(Format$, C.pos%, 1)) = 238 OR ASC(MID$(Format$, C.pos%, 1)) = 206) THEN
  170.       IF INSTR(" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789", kb$) = 0 THEN
  171.          IF Last.Char = 0 THEN
  172.             PRINT Bell$;
  173.          END IF
  174.          Pass% = FALSE
  175.       ELSEIF ASC(MID$(Format$, C.pos%, 1)) = 206 AND kb% >= 97 AND kb% <= 122 THEN
  176.          kb% = kb% - 32
  177.          kb$ = CHR$(kb%)
  178.       END IF
  179.    ELSEIF INSTR("~!@#$%^&*()_+|`-=\{}[]:;'<>,./?*" + CHR$(34), kb$) = 0 AND ASC(MID$(Format$, C.pos%, 1)) = 161 THEN
  180.       IF Last.Char = 0 THEN
  181.          PRINT Bell$;
  182.       END IF
  183.       Pass% = FALSE
  184.    ELSEIF ASC(MID$(Format$, C.pos%, 1)) = 243 THEN
  185.       IF EditFlag% THEN
  186.          IF INSTR("!#+.AFNTYXZafntyxz", kb$) = 0 THEN
  187.             PRINT Bell$;
  188.             Pass% = FALSE
  189.          ELSE
  190.             IF INSTR("FTY", kb$) > 0 THEN
  191.                kb% = kb% + 32
  192.             END IF
  193.             kb% = kb% + 128
  194.             kb$ = CHR$(kb%)
  195.          END IF
  196.       ELSE
  197.          IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789~!@#$%^&*()_+|`-=\{}[]:;'<>,./? ", kb$) = 0 THEN
  198.             PRINT Bell$;
  199.             Pass% = FALSE
  200.          END IF
  201.       END IF
  202.    ELSEIF ASC(MID$(Format$, C.pos%, 1)) = 248 OR ASC(MID$(Format$, C.pos%, 1)) = 216 OR ASC(MID$(Format$, C.pos%, 1)) = 208 THEN
  203.       IF ASC(MID$(Format$, C.pos%, 1)) = 216 AND kb% >= 97 AND kb% <= 122 THEN
  204.          kb% = kb% - 32
  205.          kb$ = CHR$(kb%)
  206.       END IF
  207.    ELSEIF (ASC(MID$(Format$, C.pos%, 1)) = 250 OR ASC(MID$(Format$, C.pos%, 1)) = 218) THEN
  208.       IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789~!@#$%^&*()_+|`-=\{}[]:;'<>,./? ", kb$) = 0 THEN
  209.          IF Last.Char = 0 THEN
  210.             PRINT Bell$;
  211.          END IF
  212.          Pass% = FALSE
  213.       ELSEIF ASC(MID$(Format$, C.pos%, 1)) = 218 AND kb% >= 97 AND kb% <= 122 THEN
  214.          kb% = kb% - 32
  215.          kb$ = CHR$(kb%)
  216.       END IF
  217.    ELSEIF INSTR(F.Choices$, MID$(Format$, C.pos%, 1)) = 0 THEN
  218.       WHILE INSTR(F.Choices$, MID$(Format$, C.pos%, 1)) = 0
  219.          C.pos% = C.pos% + 1
  220.       WEND
  221.       Pass% = FALSE
  222.    END IF
  223.   
  224. END SUB
  225.  
  226. SUB GET.INPUT (SRow%, SCol%, C.pos%, C.type%, AR.Flag%, C.Flag%, Blank%, I.Color%, Format$, Linp$, M.len%, E.Flag%, kb%) STATIC
  227.  
  228.    DIM Scrn%(15)
  229.  
  230.    IF S.Fore% <= 7 THEN
  231.       SB.attr% = S.Back% + (16 * S.Fore%)
  232.    ELSE
  233.       SB.attr% = S.Back% + (16 * (S.Fore% - 8))
  234.    END IF
  235.   
  236.    IF Status.Line.Row% = 0 OR Status.Line.Row% > 24 THEN
  237.       Status.Line.Row% = 24
  238.    END IF
  239.  
  240.    IF Status.Line.Col% = 0 OR Status.Line.Col% > 65 THEN
  241.       Status.Line.Col% = 65
  242.    END IF
  243.   
  244.    CALL GETSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  245.  
  246.   'The following routine is designed to place the word 'CAPS'
  247.   'on the screen next to 'INSERT' if the caps lock key is on.
  248.   'Assuming I can get it to work, the next step is to do the
  249.   'same for the num lock key.
  250.  
  251.    CALL KBSTATUS(Status%, 0)
  252.   
  253.    IF (Status% AND 32) = 32 THEN
  254.       IF Display.Num.Lock% THEN
  255.          Num% = 1
  256.          CALL PRINTA(Status.Line.Col% + 12, Status.Line.Row%, SB.attr%, "NUM")
  257.       END IF
  258.    ELSEIF (Status% AND 32) <> 32 THEN
  259.       Num% = 0
  260.    END IF
  261.   
  262.    IF (Status% AND 64) = 64 THEN
  263.       IF Display.Cap.Lock% THEN
  264.          Cap% = 1
  265.          CALL PRINTA(Status.Line.Col% + 7, Status.Line.Row%, SB.attr%, "CAPS")
  266.       END IF
  267.    ELSEIF (Status% AND 64) <> 64 THEN
  268.       Cap% = 0
  269.    END IF
  270.   
  271.    kb% = 0
  272.    Ins% = 0
  273.    Tab.Spaces% = 5
  274.    FALSE = 0
  275.    TRUE = NOT FALSE
  276.   
  277.    IF SRow% = 0 THEN
  278.       Row% = CSRLIN
  279.       SRow% = Row%
  280.    ELSE
  281.       Row% = SRow%
  282.    END IF
  283.  
  284.    IF SCol% = 0 THEN
  285.       Col% = POS(X)
  286.       SCol% = Col%
  287.    ELSE
  288.       Col% = SCol%
  289.    END IF
  290.  
  291.    Col% = Col% - 1
  292.  
  293.    IF C.type% = 0 THEN
  294.       C.on% = 0
  295.       C.st% = 0
  296.       C.fn% = 0
  297.    ELSEIF C.type% = 1 THEN
  298.       C.on% = 1
  299.       C.st% = 6
  300.       C.fn% = 7
  301.    ELSEIF C.type% = 2 THEN
  302.       C.on% = 1
  303.       C.st% = 6
  304.       C.fn% = 12
  305.    ELSEIF C.type% = 3 THEN
  306.       C.on% = 1
  307.       C.st% = 0
  308.       C.fn% = 12
  309.       Ins% = 1
  310.       IF Display.Insert.Key% THEN
  311.          CALL PRINTA(Status.Line.Col%, Status.Line.Row%, (SB.attr%), "INSERT")
  312.       END IF
  313.    ELSEIF C.type% = 4 THEN
  314.       C.on% = 1
  315.       C.st% = 6
  316.       C.fn% = 12
  317.    ELSE
  318.       C.type% = 1
  319.       C.on% = 1
  320.       C.st% = 6
  321.       C.fn% = 7
  322.    END IF
  323.  
  324.    F.Choices$ = CHR$(161) + CHR$(163) + CHR$(171) + CHR$(174) + CHR$(193)
  325.    F.Choices$ = F.Choices$ + CHR$(206) + CHR$(216) + CHR$(218) + CHR$(225)
  326.    F.Choices$ = F.Choices$ + CHR$(230) + CHR$(238) + CHR$(243) + CHR$(244)
  327.    F.Choices$ = F.Choices$ + CHR$(248) + CHR$(249) + CHR$(250) + CHR$(208)
  328.   
  329.    IF M.len% < LEN(Format$) AND LEN(Format$) > 0 THEN
  330.       M.len% = LEN(Format$)
  331.    END IF
  332.   
  333.    IF LEN(Linp$) <= M.len% THEN
  334.       IF M.len% > 0 THEN
  335.          Linp$ = Show$(Linp$, M.len%)
  336.       ELSE
  337.          Linp$ = ""
  338.       END IF
  339.    ELSEIF LEN(Format$) = 0 THEN
  340.       M.len% = LEN(Linp$)
  341.    END IF
  342.   
  343.    IF Blank% THEN
  344.       Linp$ = SPACE$(M.len%)
  345.    END IF
  346.  
  347.    IF I.Color% THEN
  348.       COLOR DE.Fore%, DE.Back%
  349.    ELSE
  350.       COLOR S.Fore%, S.Back%
  351.    END IF
  352.  
  353.    IF LEN(Format$) THEN
  354.      
  355.       FOR RS% = 1 TO M.len%
  356.          IF INSTR(F.Choices$, MID$(Format$, RS%, 1)) = 0 THEN
  357.             MID$(Linp$, RS%, 1) = MID$(Format$, RS%, 1)
  358.          END IF
  359.       NEXT RS%
  360.      
  361.       IF C.pos% > 0 THEN
  362.          Cur.pos% = C.pos%
  363.       ELSE
  364.          Cur.pos% = 1
  365.       END IF
  366.       WHILE INSTR(F.Choices$, MID$(Format$, Cur.pos%, 1)) = 0 AND Cur.pos% <= M.len%
  367.          Cur.pos% = Cur.pos% + 1
  368.       WEND
  369.      
  370.       IF AR.Flag% AND (Cur.pos% > M.len% OR C.pos% > M.len%) AND M.len% >= 1 THEN
  371.          C.Flag% = 0
  372.          M.pwd% = 0
  373.          COLOR S.Fore%, S.Back%
  374.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  375.          EXIT SUB
  376.       END IF
  377.  
  378.    END IF
  379.  
  380.    E.Flag% = 0
  381.    CALL PRINT.CHARSTRING(Row%, Col% + 1, Linp$, I.Color%)
  382.    IF C.pos% = 0 THEN
  383.       C.pos% = 1
  384.    ELSEIF C.pos% > M.len% THEN
  385.       C.pos% = M.len%
  386.    END IF
  387.  
  388.    IF C.on% THEN
  389.       LOCATE Row%, Col% + C.pos%, C.on%, C.st%, C.fn%
  390.    END IF
  391.  
  392. Start:
  393.              
  394.    IF LEN(Format$) THEN
  395.       WHILE INSTR(F.Choices$, MID$(Format$, C.pos%, 1)) = 0 AND C.pos% <= M.len%
  396.          C.pos% = C.pos% + 1
  397.       WEND
  398.       IF AR.Flag% AND C.pos% > M.len% AND M.len% >= 1 THEN
  399.          C.Flag% = 0
  400.          M.pwd% = 0
  401.          C.pos% = 1
  402.          COLOR S.Fore%, S.Back%
  403.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  404.          LOCATE SRow%, SCol%
  405.          EXIT SUB
  406.       END IF
  407.    END IF
  408.  
  409.    Wt! = TIMER
  410.    LOCATE Row%, Col% + C.pos%, C.on%, C.st%, C.fn%
  411.    CALL INKEY(kb%)
  412.   'kb$ = INKEY$
  413.   'WHILE LEN(kb$) = 0
  414.    WHILE kb% = 0
  415.       IF I.Color% THEN
  416.          COLOR DE.Fore%, DE.Back%
  417.       ELSE
  418.          COLOR S.Fore%, S.Back%
  419.       END IF
  420.       CALL KBSTATUS(Status%, 0)
  421.       IF ((Status% AND 64) <> 64) AND Cap% = 1 THEN
  422.          Cap% = 0
  423.          CALL PUTSCRNI(Status.Line.Col% + 7, Status.Line.Row%, Status.Line.Col% + 11, Status.Line.Row%, Scrn%(), 7)
  424.       ELSEIF ((Status% AND 64) = 64) AND Cap% = 0 THEN
  425.          IF Display.Cap.Lock% THEN
  426.             Cap% = 1
  427.             CALL PRINTA(Status.Line.Col% + 7, Status.Line.Row%, SB.attr%, "CAPS")
  428.          END IF
  429.       END IF
  430.       IF ((Status% AND 32) <> 32) AND Num% = 1 THEN
  431.          Num% = 0
  432.          CALL PUTSCRNI(Status.Line.Col% + 12, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%(), 12)
  433.       ELSEIF ((Status% AND 32) = 32) AND Num% = 0 THEN
  434.          IF Display.Num.Lock% THEN
  435.             Num% = 1
  436.             CALL PRINTA(Status.Line.Col% + 12, Status.Line.Row%, SB.attr%, "NUM")
  437.          END IF
  438.       END IF
  439.       CALL INKEY(kb%)
  440.      'kb$ = INKEY$
  441.       Nt! = TIMER
  442.       LOCATE Row%, Col% + C.pos%, C.on%, C.st%, C.fn%
  443.       IF ((Nt! - Wt! > Mtt%) OR (Nt! - Wt! <= 0)) AND Mtt% THEN
  444.          E.Flag% = 2
  445.          EXIT SUB
  446.       END IF
  447.    WEND
  448.  
  449. CheckChar:
  450.   
  451.   'IF LEN(kb$) = 1 THEN
  452.   '   kb% = ASC(kb$)
  453.   'ELSE
  454.   '   kb% = 128 + ASC(MID$(kb$, 2, 1))
  455.   'END IF
  456.    IF kb% > 0 AND kb% < 128 THEN
  457.       kb$ = CHR$(kb%)
  458.    END IF
  459.  
  460.    IF kb% = Back.Space% AND C.pos% > 1 THEN
  461.       C.pos% = C.pos% - 1
  462.       IF LEN(Format$) THEN
  463.          WHILE INSTR(F.Choices$, MID$(Format$, C.pos%, 1)) = 0 AND C.pos% > 1
  464.             C.pos% = C.pos% - 1
  465.          WEND
  466.       END IF
  467.       kb% = Delete%
  468.       LOCATE Row%, Col% + C.pos%
  469.    END IF
  470.  
  471.    IF kb% = Ctrl.Y% THEN
  472.       C.pos% = 1
  473.       LOCATE Row%, Col% + C.pos%
  474.       kb% = Ctrl.E%
  475.    END IF
  476.   
  477.    IF kb% = F.9% THEN
  478.       E.Flag% = 1
  479.       C.Flag% = 0
  480.       M.pwd% = 0
  481.       COLOR S.Fore%, S.Back%
  482.       CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  483.       LOCATE SRow%, SCol%
  484.       EXIT SUB
  485.    ELSEIF kb% = F.10% THEN
  486.       E.Flag% = 0
  487.       C.Flag% = 0
  488.       M.pwd% = 0
  489.       COLOR S.Fore%, S.Back%
  490.       CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  491.       LOCATE SRow%, SCol%
  492.       EXIT SUB
  493.    END IF
  494.  
  495.    IF Tab.Flag% THEN
  496.       IF kb% = Horiz.Tab% THEN
  497.          kb% = Down.Arrow%
  498.       ELSEIF kb% = Back.Tab% THEN
  499.          kb% = Up.Arrow%
  500.       END IF
  501.    END IF
  502.  
  503.    IF kb% = Horiz.Tab% THEN
  504.       C.pos% = C.pos% + Tab.Spaces%
  505.       IF C.pos% > M.len% THEN
  506.          C.pos% = M.len%
  507.       END IF
  508.       GOTO Start:
  509.    ELSEIF kb% = Back.Tab% THEN
  510.       C.pos% = C.pos% - Tab.Spaces%
  511.       IF C.pos% < 1 THEN
  512.          C.pos% = 1
  513.       END IF
  514.       GOTO Start:
  515.    ELSEIF kb% = Ctrl.T% OR kb% = Ctrl.Right% OR kb% = Ctrl.F% THEN
  516.       NC% = M.len%
  517.       SF% = M.len%
  518.       FOR RS% = C.pos% + 1 TO M.len%
  519.          IF MID$(Linp$, RS%, 1) = " " THEN
  520.             SF% = RS%
  521.             WHILE MID$(Linp$, RS%, 1) = " " AND RS% <= M.len%
  522.                RS% = RS% + 1
  523.             WEND
  524.             NC% = RS%
  525.             EXIT FOR
  526.          END IF
  527.       NEXT RS%
  528.       IF kb% = Ctrl.T% THEN
  529.          Last.Item$ = MID$(Linp$, C.pos%, NC% - C.pos% - 1)
  530.          Last.pos% = C.pos%
  531.          FOR X6% = C.pos% + 1 TO NC%
  532.             L.len% = LEN(RTRIM$(Linp$)) + 1
  533.             IF L.len% = 0 THEN
  534.                L.len% = 1
  535.             END IF
  536.             IF LEN(Format$) THEN
  537.                FOR RS% = C.pos% + 1 TO L.len%
  538.                   IF INSTR(F.Choices$, MID$(Format$, RS%, 1)) = 0 THEN
  539.                      MID$(Linp$, RS%, 1) = MID$(Format$, RS%, 1)
  540.                      MID$(Linp$, RS% - 1, 1) = " "
  541.                      EXIT FOR
  542.                   ELSEIF INSTR(F.Choices$, MID$(Format$, RS% - 1, 1)) AND INSTR(F.Choices$, MID$(Format$, RS%, 1)) THEN
  543.                      MID$(Linp$, RS% - 1, 1) = MID$(Linp$, RS%, 1)
  544.                      IF RS% = M.len% THEN
  545.                         MID$(Linp$, M.len%, 1) = " "
  546.                      END IF
  547.                   END IF
  548.                NEXT RS%
  549.                IF C.pos% = M.len% THEN
  550.                   MID$(Linp$, M.len%, 1) = " "
  551.                END IF
  552.             ELSE
  553.                FOR RS% = C.pos% + 1 TO L.len%
  554.                   MID$(Linp$, RS% - 1, 1) = MID$(Linp$, RS%, 1)
  555.                NEXT RS%
  556.                MID$(Linp$, L.len%, 1) = " "
  557.             END IF
  558.          NEXT X6%
  559.          CALL PRINT.CHARSTRING(0, 0, RIGHT$(Linp$, M.len% - C.pos% + 1), I.Color%)
  560.       ELSEIF kb% = Ctrl.Right% OR kb% = Ctrl.F% THEN
  561.          C.pos% = NC%
  562.       END IF
  563.       GOTO Start:
  564.    ELSEIF kb% = Ctrl.Left% OR kb% = Ctrl.A% THEN
  565.       NC% = 1
  566.       SB% = 1
  567.       FOR RS% = C.pos% - 1 TO 1 STEP -1
  568.          IF MID$(Linp$, RS%, 1) = " " THEN
  569.             SB% = RS%
  570.             WHILE MID$(Linp$, RS%, 1) = " " AND RS% > 1
  571.                RS% = RS% - 1
  572.             WEND
  573.             WHILE MID$(Linp$, RS%, 1) <> " " AND RS% > 1
  574.                RS% = RS% - 1
  575.             WEND
  576.             IF RS% = 1 THEN
  577.                NC% = 1
  578.             ELSE
  579.                NC% = RS% + 1
  580.             END IF
  581.             EXIT FOR
  582.          END IF
  583.       NEXT RS%
  584.       C.pos% = NC%
  585.       GOTO Start:
  586.    ELSEIF kb% = Page.Up% THEN
  587.       E.Flag% = 0
  588.       C.Flag% = 0
  589.       M.pwd% = 0
  590.       COLOR S.Fore%, S.Back%
  591.       CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  592.       LOCATE SRow%, SCol%
  593.       EXIT SUB
  594.    ELSEIF kb% = Page.Down% THEN
  595.       E.Flag% = 0
  596.       C.Flag% = 0
  597.       M.pwd% = 0
  598.       COLOR S.Fore%, S.Back%
  599.       CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  600.       LOCATE SRow%, SCol%
  601.       EXIT SUB
  602.    ELSEIF kb% = Insert% THEN
  603.       IF C.type% <= 3 THEN
  604.          Ins% = 1 - Ins%
  605.          IF Ins% THEN
  606.             C.st% = 0
  607.             C.fn% = 10
  608.             IF Display.Insert.Key% THEN
  609.                CALL PRINTA(Status.Line.Col%, Status.Line.Row%, (SB.attr%), "INSERT")
  610.             END IF
  611.             LOCATE Row%, Col% + C.pos%, C.on%, C.st%, C.fn%
  612.          ELSE
  613.             IF C.type% = 0 THEN
  614.                C.on% = 0
  615.                C.st% = 0
  616.                C.fn% = 0
  617.             ELSEIF C.type% = 1 THEN
  618.                C.on% = 1
  619.                C.st% = 6
  620.                C.fn% = 7
  621.             ELSEIF C.type% = 2 THEN
  622.                C.on% = 1
  623.                C.st% = 6
  624.                C.fn% = 12
  625.             ELSEIF C.type% = 3 THEN
  626.                C.on% = 1
  627.                C.st% = 6
  628.                C.fn% = 7
  629.             END IF
  630.             CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 6, Status.Line.Row%, Scrn%())
  631.             LOCATE Row%, Col% + C.pos%, C.on%, C.st%, C.fn%
  632.          END IF
  633.       END IF
  634.       GOTO Start:
  635.    ELSEIF kb% = Delete% THEN
  636.       IF LEN(Format$) THEN
  637.          FOR RS% = C.pos% + 1 TO M.len%
  638.             IF INSTR(F.Choices$, MID$(Format$, RS%, 1)) = 0 THEN
  639.                MID$(Linp$, RS%, 1) = MID$(Format$, RS%, 1)
  640.                MID$(Linp$, RS% - 1, 1) = " "
  641.                EXIT FOR
  642.             ELSEIF INSTR(F.Choices$, MID$(Format$, RS% - 1, 1)) > 0 AND INSTR(F.Choices$, MID$(Format$, RS%, 1)) > 0 THEN
  643.                MID$(Linp$, RS% - 1, 1) = MID$(Linp$, RS%, 1)
  644.                IF RS% = M.len% THEN
  645.                   MID$(Linp$, M.len%, 1) = " "
  646.                END IF
  647.             END IF
  648.          NEXT RS%
  649.          IF C.pos% = M.len% THEN
  650.             MID$(Linp$, M.len%, 1) = " "
  651.          END IF
  652.       ELSE
  653.          FOR RS% = C.pos% + 1 TO M.len%
  654.             MID$(Linp$, RS% - 1, 1) = MID$(Linp$, RS%, 1)
  655.          NEXT RS%
  656.          MID$(Linp$, M.len%, 1) = " "
  657.       END IF
  658.       CALL PRINT.CHARSTRING(0, 0, RIGHT$(Linp$, M.len% - C.pos% + 1), I.Color%)
  659.       GOTO Start:
  660.    ELSEIF (kb% = Left.Arrow% OR kb% = Ctrl.S%) THEN
  661.       IF C.pos% > 1 AND M.Arrow% = 0 THEN
  662.          C.pos% = C.pos% - 1
  663.          IF LEN(Format$) THEN
  664.             WHILE INSTR(F.Choices$, MID$(Format$, C.pos%, 1)) = 0 AND C.pos% > 1
  665.                C.pos% = C.pos% - 1
  666.             WEND
  667.          END IF
  668.          GOTO Start:
  669.       ELSEIF M.Arrow% THEN
  670.          E.Flag% = 0
  671.          C.Flag% = 0
  672.          M.pwd% = 0
  673.          M.up% = 0
  674.          M.down% = 0
  675.          COLOR S.Fore%, S.Back%
  676.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  677.          LOCATE SRow%, SCol%
  678.          EXIT SUB
  679.       END IF
  680.    ELSEIF (kb% = Right.Arrow% OR kb% = Ctrl.D%) THEN
  681.       IF C.pos% <= M.len% AND M.Arrow% = 0 THEN
  682.          C.pos% = C.pos% + 1
  683.          GOTO Start:
  684.       ELSE
  685.          E.Flag% = 0
  686.          C.Flag% = 0
  687.          M.pwd% = 0
  688.          M.up% = 0
  689.          M.down% = 0
  690.          COLOR S.Fore%, S.Back%
  691.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  692.          LOCATE SRow%, SCol%
  693.          EXIT SUB
  694.       END IF
  695.    ELSEIF kb% = Home% THEN
  696.       C.pos% = 1
  697.       IF M.len% = 0 THEN
  698.          COLOR S.Fore%, S.Back%
  699.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  700.          LOCATE SRow%, SCol%
  701.          EXIT SUB
  702.       END IF
  703.       GOTO Start:
  704.    ELSEIF kb% = End.Key% THEN
  705.       IF M.len% THEN
  706.          C.pos% = M.len%
  707.          WHILE C.pos% > 1 AND MID$(Linp$, C.pos%, 1) = " "
  708.             C.pos% = C.pos% - 1
  709.             IF LEN(Format$) THEN
  710.                WHILE INSTR(F.Choices$, MID$(Format$, C.pos%, 1)) = 0 AND C.pos% > 1
  711.                   C.pos% = C.pos% - 1
  712.                WEND
  713.             END IF
  714.          WEND
  715.          C.pos% = C.pos% + 1
  716.          GOTO Start:
  717.       ELSE
  718.          COLOR S.Fore%, S.Back%
  719.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  720.          LOCATE SRow%, SCol%
  721.          EXIT SUB
  722.       END IF
  723.    ELSEIF kb% = Escape% OR kb% = Up.Arrow% OR (kb% = Back.Space% AND C.pos% = 1) THEN
  724.       E.Flag% = 1
  725.       C.Flag% = 0
  726.       M.pwd% = 0
  727.       M.up% = 0
  728.       M.down% = 0
  729.       COLOR S.Fore%, S.Back%
  730.       CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  731.       LOCATE SRow%, SCol%
  732.       EXIT SUB
  733.    ELSEIF kb% = Enter% OR kb% = Down.Arrow% OR kb% = Ctrl.I% THEN
  734.       E.Flag% = 0
  735.       C.Flag% = 0
  736.       M.pwd% = 0
  737.       M.up% = 0
  738.       M.down% = 0
  739.       COLOR S.Fore%, S.Back%
  740.       CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  741.       LOCATE SRow%, SCol%
  742.       EXIT SUB
  743.    ELSEIF kb% = Ctrl.E% THEN
  744.       Last.Item$ = Linp$
  745.       Last.pos% = C.pos%
  746.       FOR RS% = C.pos% TO M.len%
  747.          IF LEN(Format$) THEN
  748.             IF INSTR(F.Choices$, MID$(Format$, RS%, 1)) = 0 THEN
  749.                MID$(Linp$, RS%, 1) = MID$(Format$, RS%, 1)
  750.                PRINT MID$(Format$, RS%, 1);
  751.             ELSE
  752.                MID$(Linp$, RS%, 1) = " "
  753.                PRINT " ";
  754.             END IF
  755.          ELSE
  756.             MID$(Linp$, RS%, 1) = " "
  757.             PRINT " ";
  758.          END IF
  759.       NEXT RS%
  760.       GOTO Start:
  761.    ELSEIF kb% = Ctrl.U% THEN
  762.       IF LEN(Last.Item$) > 0 AND Last.pos% <= M.len% THEN
  763.          IF LEN(RTRIM$(Linp$)) + LEN(Last.Item$) <= M.len% THEN
  764.             Linp$ = LEFT$(LEFT$(Linp$, Last.pos% - 1) + Last.Item$ + MID$(Linp$, Last.pos% + 1), M.len%)
  765.             CALL PRINT.CHARSTRING(0, Col% + Last.pos%, RIGHT$(Linp$, M.len% - Last.pos% + 1), I.Color%)
  766.             Last.Item$ = ""
  767.          ELSE
  768.             PRINT Bell$;
  769.          END IF
  770.       ELSE
  771.          PRINT Bell$;
  772.       END IF
  773.       GOTO Start:
  774.    ELSEIF (kb% < 0 OR kb% > 128) AND Key.Flag% THEN
  775.       E.Flag% = 0
  776.       C.Flag% = 0
  777.       M.pwd% = 0
  778.       COLOR S.Fore%, S.Back%
  779.       CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  780.       LOCATE SRow%, SCol%
  781.       EXIT SUB
  782.    END IF
  783.  
  784.    IF C.Flag% AND (kb% >= 97 AND kb% <= 122) THEN
  785.       kb% = kb% - 32
  786.       kb$ = CHR$(kb%)
  787.    END IF
  788.  
  789.    IF C.pos% > M.len% OR kb% < 32 OR kb% > 126 THEN
  790.       IF AR.Flag% THEN
  791.          C.Flag% = 0
  792.          M.pwd% = 0
  793.          COLOR S.Fore%, S.Back%
  794.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  795.          LOCATE SRow%, SCol%
  796.          EXIT SUB
  797.       ELSE
  798.          PRINT Bell$;
  799.          GOTO Start:
  800.       END IF
  801.    END IF
  802.  
  803.    IF LEN(Format$) THEN
  804.    
  805.       CALL GET.FORMAT(kb%, kb$, C.pos%, Format$, Pass%)
  806.       IF NOT Pass% THEN
  807.          GOTO Start
  808.       ELSEIF ASC(MID$(Format$, C.pos%, 1)) = 208 THEN
  809.          IF C.pos% = 1 THEN
  810.             IF kb% >= 97 AND kb% <= 127 THEN
  811.                kb% = kb% - 32
  812.                kb$ = CHR$(kb%)
  813.             END IF
  814.          ELSEIF C.pos% > 1 AND ASC(MID$(Linp$, C.pos% - 1, 1)) = 32 THEN
  815.             IF kb% >= 97 AND kb% <= 127 THEN
  816.                kb% = kb% - 32
  817.                kb$ = CHR$(kb%)
  818.             END IF
  819.          END IF
  820.       END IF
  821.  
  822.    END IF
  823.  
  824.    IF Ins% = 0 THEN
  825.       MID$(Linp$, C.pos%, 1) = CHR$(kb%)
  826.       C.pos% = C.pos% + 1
  827.       IF M.pwd% THEN
  828.          PRINT CHR$(178);
  829.       ELSE
  830.          CALL PRINT.CHARSTRING(0, 0, CHR$(kb%), I.Color%)
  831.       END IF
  832.       IF AR.Flag% AND C.pos% > M.len% AND M.len% >= 1 THEN
  833.          C.Flag% = 0
  834.          M.pwd% = 0
  835.          COLOR S.Fore%, S.Back%
  836.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  837.          LOCATE SRow%, SCol%
  838.          EXIT SUB
  839.       END IF
  840.    ELSEIF MID$(Linp$, M.len%, 1) <> " " THEN
  841.       PRINT Bell$;
  842.    ELSEIF C.pos% = M.len% THEN
  843.       MID$(Linp$, C.pos%, 1) = CHR$(kb%)
  844.       C.pos% = C.pos% + 1
  845.       IF M.pwd% THEN
  846.          PRINT CHR$(178);
  847.       ELSE
  848.          CALL PRINT.CHARSTRING(0, 0, CHR$(kb%), I.Color%)
  849.       END IF
  850.       IF AR.Flag% AND C.pos% > M.len% AND M.len% >= 1 THEN
  851.          C.Flag% = 0
  852.          M.pwd% = 0
  853.          COLOR S.Fore%, S.Back%
  854.          CALL PUTSCRN(Status.Line.Col%, Status.Line.Row%, Status.Line.Col% + 15, Status.Line.Row%, Scrn%())
  855.          LOCATE SRow%, SCol%
  856.          EXIT SUB
  857.       END IF
  858.    ELSE
  859.       FOR RS% = M.len% - 1 TO C.pos% STEP -1
  860.          MID$(Linp$, RS% + 1, 1) = MID$(Linp$, RS%, 1)
  861.       NEXT RS%
  862.       MID$(Linp$, C.pos%, 1) = CHR$(kb%)
  863.       IF M.pwd% THEN
  864.          PRINT CHR$(178);
  865.          C.pos% = C.pos% + 1
  866.       ELSE
  867.          CALL PRINT.CHARSTRING(0, 0, RIGHT$(Linp$, M.len% - C.pos% + 1), I.Color%)
  868.          C.pos% = C.pos% + 1
  869.       END IF
  870.    END IF
  871.  
  872.    GOTO Start:
  873.  
  874. END SUB
  875.  
  876. SUB PRINT.CHARSTRING (Row%, Col%, FmtString$, I.Color%) STATIC
  877.  
  878.    IF Row% = 0 THEN
  879.       Row% = CSRLIN
  880.    END IF
  881.  
  882.    IF Col% = 0 THEN
  883.       Col% = POS(0)
  884.    END IF
  885.  
  886.    LOCATE Row%, Col%
  887.    FOR char% = 1 TO LEN(FmtString$)
  888.       char$ = MID$(FmtString$, char%, 1)
  889.       IF ASC(char$) > 128 THEN
  890.          CALL PRINTA(Col% + char% - 1, Row%, DE.Back% + (16 * DE.Fore%), CHR$(ASC(char$) - 128))
  891.         'COLOR DE.Back%, DE.Fore%
  892.         'PRINT CHR$(ASC(Char$) - 128);
  893.         'COLOR DE.Fore%, DE.Back%
  894.       ELSE
  895.          IF I.Color% THEN
  896.             CALL PRINTA(Col% + char% - 1, Row%, DE.Fore% + (16 * DE.Back%), char$)
  897.            'COLOR DE.Fore%, DE.Back%
  898.          ELSE
  899.             CALL PRINTA(Col% + char% - 1, Row%, S.Fore% + (16 * S.Back%), char$)
  900.          END IF
  901.         'PRINT Char$;
  902.       END IF
  903.    NEXT char%
  904.   
  905. END SUB
  906.  
  907.