home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / keyboard / keybuf / buffkey.bas next >
Encoding:
BASIC Source File  |  1994-03-19  |  5.8 KB  |  234 lines
  1. '******************************BUFFKEY.BAS******************************
  2. '                        
  3. '                         Sat  03-19-1994  12:30:55
  4. '
  5. 'QuickBASIC 4.5 has few and -terrible- keyboard input commands
  6. 'if you want to control the user's input. Part of my uphill
  7. 'struggle with this language has been... and continues to be that
  8. 'problem.
  9. '
  10. 'So.... as I try to learn about Assembly, I realize that Assembly
  11. 'is WORSE!!! Far worse, but... MS-DOS does have a little interrupt
  12. 'function that allows you to enter keystrokes of up to 253 characters
  13. 'and EDIT them using the MS-DOS editing keys (left cursor key,
  14. 'the backspace key...). You set the number of key strokes and if the
  15. 'user exceeds them, the computer beeps and does not permit another
  16. 'key stroke.... Gorsh.... error detection!
  17. '
  18. 'So that is what BUFFKEY.BAS does. It uses the Function &HA in AX with
  19. 'Interrupt &H21 to do that. See BUFFKEY.TXT for a more lucid story....
  20. '
  21. '    ╔════════════════════════════════════════════════════════╗
  22. '    ║                                                        ║
  23. '    ║     BUFFKEY.BAS is a slick and simple line editor!     ║
  24. '    ║                                                        ║
  25. '    ╚════════════════════════════════════════════════════════╝
  26. '
  27. 'REFERENCES:
  28. '
  29. '1.  Norton's PC Programming Bible, 1993, Microsoft Press
  30. '2.  QuickBasic Programming Toolbox, JJ Craig, 1991, Microsoft Press
  31. '
  32. 'John De Palma on CompuServe 76076,571
  33. '
  34. '===============================END TEXT================================
  35.  
  36.      'Declarations
  37.      DEFINT A-Z
  38.      DECLARE FUNCTION BufferedKeyInput$ (n%)
  39.      DECLARE SUB TextBox (Row%, Col%, Message$, Outline%, Length%)
  40.      DECLARE FUNCTION Center% (text$)
  41.      DECLARE SUB LocateIt (Row%, text$)
  42.      '$INCLUDE: 'johns.bi'
  43.  
  44.      'Executable code follows
  45.      Row% = 6
  46.      n% = 12
  47.      COLOR 15, 1
  48.      CLS
  49.  
  50.      COLOR 14, 4
  51.      Message$ = "Buffered Key Input ala MS-DOS!"
  52.      CALL TextBox(Row% - 4, 0, Message$, 4, 0)
  53.  
  54.  
  55.      COLOR 15, 4
  56.      Message$ = SPACE$(n%)
  57.      CALL TextBox(Row%, 0, Message$, 5, 0)
  58.      text$ = "PRESS: {Enter}"
  59.      COLOR 12, 4
  60.      CALL LocateIt(Row%, text$)
  61.      text$ = "to END edit"
  62.      CALL LocateIt(Row% + 2, text$)
  63.      COLOR 11, 0
  64.      CALL LocateIt(Row% + 1, Message$)
  65.      LOCATE Row% + 1, Center%(Message$)
  66.      Strg$ = BufferedKeyInput$(n%)
  67.  
  68.      BoxWidth% = LEN(Strg$)
  69.      Message$ = SPACE$(BoxWidth%)
  70.      COLOR 15, 2
  71.      CALL TextBox(Row% + 6, 0, Message$, 3, 0)
  72.      COLOR 11, 0
  73.      CALL LocateIt(Row% + 7, Strg$)
  74.  
  75.      WHILE INKEY$ <> "": WEND
  76.      WHILE INKEY$ = "": WEND
  77.  
  78.      END
  79.  
  80. FUNCTION BufferedKeyInput$ (n%) STATIC
  81.  
  82.      DIM Regs AS RegType
  83.      b$ = CHR$(n% + 1) + SPACE$(n% + 1) + CHR$(13)   'see EXPLANATION
  84.      Regs.ax = &HA00                     'BufferkeyInput MS-DOS Function
  85.      Regs.ds = VARSEG(b$)                'segment of string b$
  86.      Regs.dx = SADD(b$)                  'offset of string b$
  87.      'using qb.bi INCLUDE file
  88.      CALL INTERRUPTX(&H21, Regs, Regs)
  89.      count% = ASC(MID$(b$, 2, 1))        'length of the string b$
  90.  
  91.      'EXPLANATION of b$ command
  92.      'byte one of b$ contains the working -size- of the string.
  93.      'byte two is the -actual size- of the string that MS-DOS uses.
  94.      'last byte is a carriage return which is needed to prevent
  95.      'a STRING SPACE CORRUPT Run Time error when you use this
  96.      'so the return string starts at byte three (3), and does NOT
  97.      'include the carriage return
  98.      'see below
  99.      BufferedKeyInput$ = MID$(b$, 3, count%)
  100.  
  101.  
  102. END FUNCTION
  103.  
  104. FUNCTION Center% (text$)
  105. Center% = 41 - LEN(text$) \ 2
  106. END FUNCTION
  107.  
  108. SUB LocateIt (Row%, text$)
  109. LOCATE Row%, Center(text$)
  110. PRINT text$;
  111. END SUB
  112.  
  113. SUB TextBox (Row%, Col%, Message$, Outline%, Length%)
  114.  
  115.     'Will put a message into a three line box -or-
  116.     'draw a box without a message using Message$=SPACE$(x)
  117.     'where "x" is the width of the box and Length%= number of lines > 3
  118.     'All boxes are centered.
  119.     'Now to make them non centered....
  120.  
  121.     Message$ = LEFT$(Message$, 60)
  122.     BoxWidth% = LEN(Message$) + 4
  123.     SELECT CASE Outline%
  124.         CASE 0
  125.             j = 8 * 5 + 1
  126.         CASE 1
  127.             j = 1
  128.         CASE 2
  129.             j = 8 + 1
  130.         CASE 3
  131.             j = 8 * 2 + 1
  132.         CASE 4
  133.             j = 8 * 3 + 1
  134.         CASE 5
  135.             j = 8 * 4 + 1
  136.         CASE ELSE
  137.             j = 8 * 5 + 1
  138.     END SELECT
  139.  
  140.     REDIM Box$(1 TO 8 * 6)
  141.  
  142. 'single line box
  143.     Box$(1) = "┌"
  144.     Box$(2) = "─"
  145.     Box$(3) = "┐"
  146.     Box$(4) = "│"
  147.     Box$(5) = "│"
  148.     Box$(6) = "└"
  149.     Box$(7) = "─"
  150.     Box$(8) = "┘"
  151.  
  152. 'double top box
  153.     Box$(9) = "╒"
  154.     Box$(10) = "═"
  155.     Box$(11) = "╕"
  156.     Box$(12) = "│"
  157.     Box$(13) = "│"
  158.     Box$(14) = "╘"
  159.     Box$(15) = "═"
  160.     Box$(16) = "╛"
  161.  
  162. 'double side box
  163.     Box$(17) = "╓"
  164.     Box$(18) = "─"
  165.     Box$(19) = "╖"
  166.     Box$(20) = "║"
  167.     Box$(21) = "║"
  168.     Box$(22) = "╙"
  169.     Box$(23) = "─"
  170.     Box$(24) = "╜"
  171.  
  172. 'double box
  173.     Box$(25) = "╔"
  174.     Box$(26) = "═"
  175.     Box$(27) = "╗"
  176.     Box$(28) = "║"
  177.     Box$(29) = "║"
  178.     Box$(30) = "╚"
  179.     Box$(31) = "═"
  180.     Box$(32) = "╝"
  181.  
  182. 'bold and thick box
  183.     Box$(33) = "█"
  184.     Box$(34) = "▀"
  185.     Box$(35) = "█"
  186.     Box$(36) = "█"
  187.     Box$(37) = "█"
  188.     Box$(38) = "█"
  189.     Box$(39) = "▄"
  190.     Box$(40) = "█"
  191.  
  192. 'no box
  193.     Box$(41) = " "
  194.     Box$(42) = " "
  195.     Box$(43) = " "
  196.     Box$(44) = " "
  197.     Box$(45) = " "
  198.     Box$(46) = " "
  199.     Box$(47) = " "
  200.     Box$(48) = " "
  201.  
  202.     IF Col% = 0 THEN
  203.      
  204.         BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  205.         CALL LocateIt(Row%, BoxText$)
  206.  
  207.         FOR i = 1 TO Length% + 1
  208.         BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  209.         CALL LocateIt(Row% + i, BoxText$)
  210.         NEXT i
  211.  
  212.         BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  213.         CALL LocateIt(Row% + i, BoxText$)
  214.  
  215.     ELSE
  216.  
  217.         BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  218.         LOCATE Row%, Col%
  219.         PRINT BoxText$
  220.  
  221.         FOR i = 1 TO Length% + 1
  222.         BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  223.         LOCATE Row% + i, Col%
  224.         PRINT BoxText$
  225.         NEXT i
  226.  
  227.         BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  228.         LOCATE Row% + i, Col%
  229.         PRINT BoxText$
  230.  
  231.     END IF
  232. END SUB
  233.  
  234.