home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l196 / 3.ddi / GENERAL.BA$ / GENERAL.bin
Encoding:
Text File  |  1990-06-24  |  7.5 KB  |  209 lines
  1. '============================================================================
  2. '
  3. '     GENERAL.BAS - General Routines for the User Interface Toolbox in
  4. '           Microsoft BASIC 7.1, Professional Development System
  5. '              Copyright (C) 1987-1990, Microsoft Corporation
  6. '
  7. '  NOTE:    This sample source code toolbox is intended to demonstrate some
  8. '           of the extended capabilities of Microsoft BASIC 7.1 Professional
  9. '           Development system that can help to leverage the professional
  10. '           developer's time more effectively.  While you are free to use,
  11. '           modify, or distribute the routines in this module in any way you
  12. '           find useful, it should be noted that these are examples only and
  13. '           should not be relied upon as a fully-tested "add-on" library.
  14. '
  15. '  PURPOSE: These are the general purpose routines needed by the other
  16. '           modules in the user interface toolbox.
  17. '
  18. '  To create a library and QuickLib containing the routines found
  19. '  in this file, follow these steps:
  20. '       BC /X/FS general.bas
  21. '       LIB general.lib + general + uiasm + qbx.lib;
  22. '       LINK /Q general.lib, general.qlb,,qbxqlb.lib;
  23. '  Creating a library and QuickLib for any of the other UI toolbox files
  24. '  (WINDOW.BAS, MENU.BAS and MOUSE.BAS) is done this way also.
  25. '
  26. '  To create a library and QuickLib containing all routines from
  27. '  the User Interface toolbox follow these steps:
  28. '       BC /X/FS general.bas
  29. '       BC /X/FS window.bas
  30. '       BC /X/FS mouse.bas
  31. '       BC /X/FS menu.bas
  32. '       LIB uitb.lib + general + window + mouse + menu + uiasm + qbx.lib;
  33. '       LINK /Q uitb.lib, uitb.qlb,,qbxqlb.lib;
  34. '  If you are going to use this QuickLib in conjunction with the font source
  35. '  code (FONTB.BAS) or the charting source code (CHRTB.BAS), you need to
  36. '  include the assembly code routines referenced in these files.  For the font
  37. '  routines, perform the following LIB command after creating the library but
  38. '  before creating the QuickLib as described above:
  39. '       LIB uitb.lib + fontasm;
  40. '  For the charting routines, perform the following LIB command after creating
  41. '  the library but before creating the QuickLib as described above:
  42. '       LIB uitb.lib + chrtasm;
  43. '
  44. '============================================================================
  45.  
  46. DEFINT A-Z
  47.  
  48. '$INCLUDE: 'general.bi'
  49. '$INCLUDE: 'mouse.bi'
  50.  
  51. FUNCTION AltToASCII$ (kbd$)
  52.     ' =======================================================================
  53.     ' Converts Alt+A to A,Alt+B to B, etc.  You send it a string.  The right
  54.     ' most character is compared to the string below, and is converted to
  55.     ' the proper character.
  56.     ' =======================================================================
  57.     index = INSTR("xyz{|}~Çü !" + CHR$(34) + "#$%&,-./012éâ", RIGHT$(kbd$, 1))
  58.  
  59.     IF index = 0 THEN
  60.         AltToASCII = ""
  61.     ELSE
  62.         AltToASCII = MID$("1234567890QWERTYUIOPASDFGHJKLZXCVBNM-=", index, 1)
  63.     END IF
  64.  
  65. END FUNCTION
  66.  
  67. SUB Box (row1, col1, row2, col2, fore, back, border$, fillFlag) STATIC
  68.  
  69.     '=======================================================================
  70.     '  Use default border if an illegal border$ is passed
  71.     '=======================================================================
  72.  
  73.     IF LEN(border$) < 9 THEN
  74.         t$ = "┌─┐│ │└─┘"
  75.     ELSE
  76.         t$ = border$
  77.     END IF
  78.  
  79.     ' =======================================================================
  80.     ' Check coordinates for validity, then draw box
  81.     ' =======================================================================
  82.  
  83.     IF col1 <= (col2 - 2) AND row1 <= (row2 - 2) AND col1 >= MINCOL AND row1 >= MINROW AND col2 <= MAXCOL AND row2 <= MAXROW THEN
  84.         MouseHide
  85.         BoxWidth = col2 - col1 + 1
  86.         BoxHeight = row2 - row1 + 1
  87.         LOCATE row1, col1
  88.         COLOR fore, back
  89.         PRINT LEFT$(t$, 1); STRING$(BoxWidth - 2, MID$(t$, 2, 1)); MID$(t$, 3, 1)
  90.         LOCATE row2, col1
  91.         PRINT MID$(t$, 7, 1); STRING$(BoxWidth - 2, MID$(t$, 8, 1)); MID$(t$, 9, 1);
  92.  
  93.         FOR a = row1 + 1 TO row1 + BoxHeight - 2
  94.             LOCATE a, col1
  95.             PRINT MID$(t$, 4, 1);
  96.  
  97.             IF fillFlag THEN
  98.                 PRINT STRING$(BoxWidth - 2, MID$(t$, 5, 1));
  99.             ELSE
  100.                 LOCATE a, col1 + BoxWidth - 1
  101.             END IF
  102.  
  103.             PRINT MID$(t$, 6, 1);
  104.         NEXT a
  105.         LOCATE row1 + 1, col1 + 1
  106.         MouseShow
  107.     END IF
  108.  
  109. END SUB
  110.  
  111. SUB GetBackground (row1, col1, row2, col2, buffer$) STATIC
  112.  
  113.     ' =======================================================================
  114.     ' Create enough space in buffer$ to hold the screen info behind the box
  115.     ' Then, call GetCopyBox to store the background in buffer$
  116.     ' =======================================================================
  117.  
  118.     IF row1 >= 1 AND row2 <= MAXROW AND col1 >= 1 AND col2 <= MAXCOL THEN
  119.         Wid = col2 - col1 + 1
  120.         Hei = row2 - row1 + 1
  121.         size = 4 + (2 * Wid * Hei)
  122.         buffer$ = SPACE$(size)
  123.  
  124.         CALL GetCopyBox(row1, col1, row2, col2, buffer$)
  125.     END IF
  126.  
  127. END SUB
  128.  
  129. FUNCTION GetShiftState (bit)
  130.  
  131.     ' =======================================================================
  132.     ' Returns the shift state after calling interrupt 22
  133.     '    bit 0 : right shift
  134.     '        1 : left shift
  135.     '        2 : ctrl key
  136.     '        3 : alt key
  137.     '        4 : scroll lock
  138.     '        5 : num lock
  139.     '        6 : caps lock
  140.     '        7 : insert state
  141.     ' =======================================================================
  142.  
  143.     IF bit >= 0 AND bit <= 7 THEN
  144.         DIM regs AS RegType
  145.         regs.ax = 2 * 256
  146.         INTERRUPT 22, regs, regs
  147.       
  148.         IF regs.ax AND 2 ^ bit THEN
  149.             GetShiftState = TRUE
  150.         ELSE
  151.             GetShiftState = FALSE
  152.         END IF
  153.     ELSE
  154.         GetShiftState = FALSE
  155.     END IF
  156.  
  157. END FUNCTION
  158.  
  159. SUB PutBackground (row, col, buffer$)
  160.  
  161.     ' =======================================================================
  162.     ' This sub checks the boundries before executing the put command
  163.     ' =======================================================================
  164.  
  165.     IF row >= 1 AND row <= MAXROW AND col >= 1 AND col <= MAXCOL THEN
  166.         CALL PutCopyBox(row, col, buffer$)
  167.     END IF
  168.  
  169. END SUB
  170.  
  171. SUB scroll (row1, col1, row2, col2, lines, attr)
  172.  
  173.     ' =======================================================================
  174.     ' Make sure coordinates are in proper order
  175.     ' =======================================================================
  176.  
  177.     IF row1 > row2 THEN
  178.         SWAP row1, row2
  179.     END IF
  180.    
  181.     IF col1 > col2 THEN
  182.         SWAP col1, col2
  183.     END IF
  184.  
  185.      ' ======================================================================
  186.      ' If coordinates are valid, prepare registers, and call interrupt
  187.      ' ======================================================================
  188.  
  189.     IF row1 >= MINROW AND row2 <= MAXROW AND col1 >= MINCOL AND col2 <= MAXCOL THEN
  190.         DIM regs AS RegType
  191.  
  192.         IF lines < 0 THEN
  193.             regs.ax = 256 * 7 + (-lines)
  194.             regs.bx = 256 * attr
  195.             regs.cx = 256 * (row1 - 1) + (col1 - 1)
  196.             regs.dx = 256 * (row2 - 1) + (col2 - 1)
  197.         ELSE
  198.             regs.ax = 256 * 6 + lines
  199.             regs.bx = 256 * (attr MOD 8) * 16
  200.             regs.cx = 256 * (row1 - 1) + (col1 - 1)
  201.             regs.dx = 256 * (row2 - 1) + (col2 - 1)
  202.         END IF
  203.  
  204.         INTERRUPT 16, regs, regs
  205.     END IF
  206.  
  207. END SUB
  208.  
  209.