home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l391 / 2.ddi / MOUSE.BA$ / MOUSE.bin
Encoding:
Text File  |  1992-08-19  |  9.4 KB  |  368 lines
  1. ' ------------------------------------------------------------------------
  2. ' Visual Basic for MS-DOS Mouse Toolkit
  3. '
  4. ' The Mouse Toolkit (MOUSE.BAS) provides mouse support
  5. ' for text-mode and graphics programs when Visual Basic
  6. ' forms are not showing.  The Mouse Toolkit provides
  7. ' these procedures:
  8. '       MouseBorder - sets mouse movement boundaries.
  9. '       MouseDriver - checks for presence of mouse and
  10. '                     provides access to mouse functions.
  11. '       MouseHide   - hides mouse pointer.
  12. '       MouseInit   - intializes mouse driver.
  13. '       MousePoll   - get mouse pointer location and button
  14. '                     status.
  15. '       MouseShow   - displays mouse location.
  16. '       SetHigh     - sets highest resolution video mode available.
  17. '       ScrSettings - gets current Basic screen mode and screen width.
  18. '
  19. ' See the"Microsoft Mouse Programmer's Guide" (Microsoft Press) for
  20. ' extensive information on programming for the mouse in Basic and
  21. ' other languages.
  22. '
  23. ' To use the Mouse ToolKit routines in your program,
  24. ' include MOUSE.BAS in your program and call the
  25. ' appropriate procedures.  Note, if you use MOUSE.BAS
  26. ' in your program, you will also have to use VBDOS.LIB
  27. ' and VBDOS.QLB for the required CALL INTERRUPT support.
  28. '
  29. ' A toolkit library (MOUSE.LIB) and Quick
  30. ' library (MOUSE.QLB) can be created from MOUSE.BAS
  31. ' as follows:
  32. '    BC  mouse.bas /X;
  33. '    DEL mouse.lib
  34. '    LIB mouse.lib + mouse.obj + vbdos.lib;
  35. '    LINK /Q mouse.lib, mouse.qlb,,vbdosqlb.lib;
  36. '
  37. ' MOUSE.COM or MOUSE.SYS must be loaded to access the
  38. ' mouse.
  39. '
  40. '
  41. ' Copyright (C) 1982-1992 Microsoft Corporation
  42. '
  43. ' You have a royalty-free right to use, modify, reproduce
  44. ' and distribute the sample applications and toolkits provided with
  45. ' Visual Basic for MS-DOS (and/or any modified version)
  46. ' in any way you find useful, provided that you agree that
  47. ' Microsoft has no warranty, obligations or liability for
  48. ' any of the sample applications or toolkits.
  49. ' ------------------------------------------------------------------------
  50.  
  51. DEFINT A-Z
  52.  
  53. ' Include files containing declarations for called procedures.
  54. '$INCLUDE: 'MOUSE.BI'
  55. '$INCLUDE: 'VBDOS.BI'
  56.  
  57. CONST FALSE = 0
  58. CONST TRUE = NOT FALSE
  59.  
  60. '--------------------------------------------------
  61. ' Sample usage of the mouse routines. This code is
  62. ' only executed if MOUSE.BAS is the start-up file.
  63. ' Parameter information for each mouse procedure
  64. ' appears in the header comments for the procedure.
  65. ' Note, to call mouse procedures, you should first
  66. ' hide all visible forms (SCREEN.HIDE) -- using the
  67. ' mouse procedures while forms are showing may
  68. ' yield unpredictable results.
  69. '--------------------------------------------------
  70.  
  71. CLS
  72.  
  73. ' Change to highest resolution graphics mode available.
  74. ' Note that the Mouse Toolkit works in text mode (SCREEN 0)
  75. ' as well as graphics modes.
  76. SetHigh
  77.                               
  78. ' Check if mouse driver is installed.
  79. MouseInit
  80.  
  81. ' Display mouse pointer.
  82. MouseShow
  83.  
  84. LOCATE 20, 1: PRINT "Press right mouse button or any key to end program."
  85.  
  86. DO UNTIL rButton OR INKEY$ <> ""
  87.     ' Get mouse location and button status.
  88.     MousePoll row, col, lButton, rButton
  89.                         
  90.     IF lButton THEN lState$ = "is" ELSE lState$ = "is not"
  91.     LOCATE 21, 1: PRINT "The left mouse button " + lState$ + " pressed.     "
  92.     LOCATE 22, 1: PRINT "Mouse position: "; row; ", "; col; "    "
  93. LOOP
  94.  
  95. ' MouseBorder procedure.
  96. '
  97. ' Sets vertical and horizontal boundaries for
  98. ' mouse pointer travel.
  99. '
  100. ' Parameters:
  101. '   row1, row2 - begining and ending vertical
  102. '                boundaries.
  103. '   col1, col2 - beginning and ending horizontal
  104. '                boundaries.
  105. '
  106. ' Row and column coordinates are determined by
  107. ' current screen mode and width -- returned by
  108. ' the ScrSettings procedure.
  109. '
  110. STATIC SUB MouseBorder (row1, col1, row2, col2)
  111.  
  112.     ScrSettings sMode, sWidth           ' Get current screen mode
  113.                                         '  to determine coordinate settings.
  114.  
  115.     SELECT CASE sMode
  116.         CASE 0                          ' Text-mode coordinates
  117.             row1 = row1 - 1 * 8
  118.             col1 = col1 - 1 * 8
  119.             row2 = row2 - 1 * 8
  120.             col2 = col2 - 1 * 8
  121.         CASE 1, 7, 13                   ' Graphic mode coordinates
  122.             col1 = col1 * 2
  123.             col2 = col2 * 2
  124.         CASE 2, 3, 4, 8, 9, 10, 11, 12
  125.                                         ' No adjustment needed
  126.     END SELECT
  127.  
  128.     MouseDriver 7, 0, col1, col2
  129.     MouseDriver 8, 0, row1, row2
  130.  
  131. END SUB
  132.  
  133. ' MouseDriver procedure.
  134. '
  135. ' Provides a Basic language interface to
  136. ' the mouse routines in MOUSE.COM or MOUSE.SYS.
  137. '
  138. ' Parameters:
  139. '   m0     - mouse task to perform:
  140. '              0 - initialize mouse routines.
  141. '              1 - display mouse pointer.
  142. '              2 - hide mouse pointer.
  143. '              3 - poll mouse location and
  144. '                  button status.
  145. '              7 - set horizontal boundary for mouse
  146. '                  travel.
  147. '              8 - set vertical boundary for mouse
  148. '                  travel.
  149. '   m1, m2, - these vary for different mouse tasks.
  150. '   and m3    See MouseInit, MouseShow, MouseHide,
  151. '             MouseShow, MousePoll, and MouseBorder
  152. '             procedures for valid settings.
  153. '
  154. ' The Mouse Toolkit provides access to the mouse routines
  155. ' listed above. For information on other mouse routines
  156. ' and other valid settings for m0, m1, m2, and m3, see
  157. ' the "Microsoft Mouse Programmer's Guide" (Microsoft
  158. ' Press).
  159. '
  160. STATIC SUB MouseDriver (m0, m1, m2, m3)
  161.  
  162.     DIM regs AS RegType
  163.  
  164.     IF MouseChecked = FALSE THEN
  165.         DEF SEG = 0
  166.  
  167.         MouseSegment& = 256& * PEEK(207) + PEEK(206)
  168.         MouseOffset& = 256& * PEEK(205) + PEEK(204)
  169.  
  170.         DEF SEG = MouseSegment&
  171.  
  172.         IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THEN
  173.             MousePresent = FALSE
  174.             MouseChecked = TRUE
  175.             DEF SEG
  176.         END IF
  177.     END IF
  178.  
  179.     IF MousePresent = FALSE AND MouseChecked = TRUE THEN
  180.         EXIT SUB
  181.     END IF
  182.  
  183.     ' Calls interrupt 51 to invoke mouse functions in the MS Mouse Driver.
  184.     
  185.     regs.ax = m0
  186.     regs.bx = m1
  187.     regs.cx = m2
  188.     regs.dx = m3
  189.  
  190.     INTERRUPT 51, regs, regs
  191.  
  192.     m0 = regs.ax
  193.     m1 = regs.bx
  194.     m2 = regs.cx
  195.      m3 = regs.dx
  196.  
  197.     IF MouseChecked THEN EXIT SUB
  198.  
  199.     ' Check for successful mouse initialization
  200.  
  201.     IF m0 AND NOT MouseChecked THEN
  202.         MousePresent = TRUE
  203.         DEF SEG
  204.     END IF
  205.  
  206.     MouseChecked = TRUE
  207.     
  208. END SUB
  209.  
  210. ' MouseHide procedure.
  211. '
  212. ' Hides the mouse pointer.
  213. '
  214. SUB MouseHide ()
  215.  
  216.    MouseDriver 2, 0, 0, 0
  217.  
  218. END SUB
  219.  
  220. ' MouseInit procedure.
  221. '
  222. ' Initializes the mouse driver.
  223. '
  224. SUB MouseInit ()
  225.  
  226.     MouseDriver MousePresent%, 0, 0, 0
  227.  
  228.     IF MousePresent% = FALSE THEN
  229.         Action = MSGBOX("Mouse not present or mouse driver not installed. End program?", 4, "Error")
  230.         IF Action = 6 THEN STOP
  231.     END IF
  232.  
  233. END SUB
  234.  
  235. ' MousePoll procedure.
  236. '
  237. ' Gets the mouse pointer location and button
  238. ' status.
  239. '
  240. ' Parameters:
  241. '   row     - vertical location of mouse pointer.
  242. '   col     - horizontal location of mouse pointer.
  243. '   lButton - status of left mouse button:
  244. '                0 - not pressed.
  245. '                1 - pressed.
  246. '   rButton - status of right mouse button:
  247. '                0 - not pressed.
  248. '                1 - pressed.
  249. '
  250. ' The valid range for row and col are determined
  251. ' by the current screen mode and width returned
  252. ' by the ScrSettings procedure.
  253. '
  254. STATIC SUB MousePoll (row, col, lButton, rButton)
  255.  
  256.     MouseDriver 3, button, col, row
  257.  
  258.     ScrSettings sMode, sWidth   ' Get current screen mode to determine coordinate
  259.                                 ' settings.
  260.     SELECT CASE sMode
  261.         CASE 0                  ' Text-mode coordinates
  262.             row = row / 8 + 1
  263.             col = col / 8 + 1
  264.         CASE 1, 7, 13           ' Graphic mode coordinates
  265.             col = col / 2
  266.         CASE 2, 3, 4, 8, 9, 10, 11, 12
  267.                                 ' No adjustment needed.
  268.     END SELECT
  269.  
  270.     IF button AND 1 THEN
  271.         lButton = TRUE
  272.     ELSE
  273.         lButton = FALSE
  274.     END IF
  275.  
  276.     IF button AND 2 THEN
  277.         rButton = TRUE
  278.     ELSE
  279.         rButton = FALSE
  280.     END IF
  281.  
  282. END SUB
  283.  
  284. ' MouseShow procedure.
  285. '
  286. ' Displays mouse pointer.
  287. '
  288. SUB MouseShow ()
  289.  
  290.     MouseDriver 1, 0, 0, 0
  291.  
  292. END SUB
  293.  
  294. ' ScrSettings procedure.
  295. '
  296. ' Gets the current Basic screen mode setting and width.
  297. '
  298. ' Parameters:
  299. '   sMode  - the current Basic screen mode. See the
  300. '            SCREEN statement for valid return values
  301. '            (0-13).
  302. '   sWidth - the current width of the display in
  303. '            characters.
  304. '
  305. SUB ScrSettings (sMode AS INTEGER, sWidth AS INTEGER)
  306.  
  307.     ' =======================================================================
  308.     ' Gets current Basic screen mode and width setting.
  309.     ' =======================================================================
  310.  
  311.     DIM regs AS RegType
  312.  
  313.     regs.ax = &HF00
  314.  
  315.     INTERRUPT &H10, regs, regs          ' &H10 returns video
  316.                                         ' information.
  317.  
  318.     sWidth = (regs.ax AND &HFF00) \ 256 ' High byte of AX (AH).
  319.     sMode = regs.ax AND &HFF            ' Low byte of AX (AL).
  320.  
  321.     SELECT CASE sMode                   ' Map MS-DOS video mode
  322.         CASE 3                          '  number to Basic screen
  323.             sMode = 0                   '  modes.
  324.         CASE 4
  325.             sMode = 1
  326.         CASE 6
  327.             sMode = 2
  328.         CASE 13
  329.             sMode = 7
  330.         CASE 14
  331.             sMode = 8
  332.         CASE 15
  333.             sMode = 10
  334.         CASE 16
  335.             sMode = 9
  336.         CASE 17
  337.             sMode = 11
  338.         CASE 18
  339.             sMode = 12
  340.         CASE 19
  341.             sMode = 13
  342.         CASE ELSE
  343.             sMode = 3
  344.     END SELECT
  345.  
  346.  
  347. END SUB
  348.  
  349. ' SetHigh procedure.
  350. '
  351. ' Sets the highest-resolution graphics screen mode
  352. ' that is available for the current hardware.
  353. '
  354. SUB SetHigh ()
  355.  
  356. ON LOCAL ERROR RESUME NEXT
  357.  
  358. ' Step through video modes (12-0) until
  359. ' one works.
  360.  
  361. FOR Mode = 12 TO 0 STEP -1
  362.     SCREEN Mode
  363.     IF ERR = 0 THEN EXIT SUB
  364. NEXT Mode
  365.  
  366. END SUB
  367.  
  368.