home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / S12780.ZIP / MOUSE.BAS < prev    next >
BASIC Source File  |  1990-10-25  |  14KB  |  466 lines
  1. '============================================================================
  2. '
  3. '    MOUSE.BAS - Mouse Support 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 routines are required for mouse support in the user
  16. '           interface toolbox, but they may be used independently as well.
  17. '
  18. '  NOTE: These routines have been modified to support under OS/2 both
  19. '        full-screen and windowed command prompts using OS/2 API functions
  20. '        to provide similar effect to the DOS based code.
  21. '
  22. '  All sections of code that have been modified will have a comment
  23. '  preseeding the modifications in the following manner :
  24. '
  25. '  '| --- Modified to support OS/2 changes ---
  26. '  '|
  27. '  '| Description of changes
  28. '  '| ----------------------
  29. '  '|
  30. '
  31. '  THIS IS SAMPLE CODE AND IS NOT TO BE CONSIDERED A COMPLETE BUG FREE
  32. '  PACKAGE.  THIS CODE IS DESIGNED SPECIFICALLY TO RUN UNDER OS/2 PROTECTED
  33. '  MODE.  THE ORIGINAL CODE HAS NOT BEEN MODIFIED IN ANY WAY, EXCEPT TO
  34. '  PROVIDE THIS FUNCTIONALITY.
  35. '
  36. '============================================================================
  37.  
  38. DEFINT A-Z
  39.  
  40. '$INCLUDE: 'general.bi'
  41. '$INCLUDE: 'mouse.bi'
  42. '$INCLUDE: 'menu.bi'
  43.  
  44. COMMON SHARED /uitools/ GloMenu      AS MenuMiscType
  45. COMMON SHARED /uitools/ GloTitle()   AS MenuTitleType
  46. COMMON SHARED /uitools/ GloItem()    AS MenuItemType
  47.  
  48. '| --- Modified to support OS/2 changes ---
  49. '|
  50. '| Added common and type statements for the OS/2 API MOU fucntions
  51. '|
  52.  
  53. COMMON SHARED /MOUCALLS/ MouseHandle AS INTEGER
  54.  
  55. TYPE tMouseEvent
  56.     Action    as Integer
  57.     EventTime as Long
  58.     MouseRow  as Integer
  59.     MouseCol  as Integer
  60. END TYPE
  61.  
  62. TYPE tPtrRect
  63.     ULRow as Integer
  64.     ULCol as Integer
  65.     LRRow as Integer
  66.     LRCol as Integer
  67. END TYPE
  68.  
  69. TYPE tCell
  70.     Char as string * 1
  71.     Attr as string * 1
  72. END TYPE
  73.  
  74. TYPE tMousePointer
  75.     Mask1 as tCell
  76.     Mask2 as tCell
  77. END TYPE
  78.  
  79. TYPE tMouseScale
  80.     RowScale as Integer
  81.     ColScale as Integer
  82. END TYPE
  83.  
  84. TYPE tMousePointerInfo
  85.     cb as integer
  86.     col as integer
  87.     row as integer
  88.     colhot as integer
  89.     rowhot as integer
  90. END TYPE
  91.  
  92. TYPE tMousePosition
  93.     Row as Integer
  94.     Col as Integer
  95. End Type
  96.  
  97. TYPE tMouseLimits
  98.     LLimit AS Integer
  99.     RLimit AS Integer
  100.     TLimit AS Integer
  101.     BLimit AS Integer
  102. END TYPE
  103.  
  104. TYPE tMouseQue
  105.     Events as Integer
  106.     MaxEvents as Integer
  107. END TYPE
  108.  
  109. '| DECLARE Statements for OS/2 Mouse API Functions
  110.  
  111. DECLARE FUNCTION MouOpen%        ( BYVAL MouDriverAddr&, _
  112.                                    SEG MouseHandle%      _
  113.                                  )
  114.  
  115. DECLARE FUNCTION MouDrawPtr%     ( BYVAL MouseHandle% )
  116.  
  117. DECLARE FUNCTION MouSynch% ( BYVAL MouseWait% )
  118.  
  119. DECLARE FUNCTION MouRemovePtr%   ( SEG PtrRect as tPtrRect, _
  120.                                    BYVAL MouseHandle%       _
  121.                                  )
  122.  
  123. DECLARE FUNCTION MouReadEventQue% ( SEG MouseQue as tMouseEvent, _
  124.                                     SEG MouseWait%,              _
  125.                                     BYVAL MouseHandle%           _
  126.                                   )
  127.  
  128. DECLARE FUNCTION MouGetNumButtons% ( SEG MouseButton%,  _
  129.                                      BYVAL MouseHandle% _
  130.                                    )
  131.  
  132. DECLARE FUNCTION MouSetPtrShape% ( SEG MousePointer as tMousePointer, _
  133.                                    SEG MousePointerInfo as tMousePointerInfo, _
  134.                                    BYVAL MouseHandle%           _
  135.                                  )
  136.  
  137. DECLARE FUNCTION MouGetPtrShape% ( SEG MousePointer as tMousePointer, _
  138.                                    SEG MousePointerInfo as tMousePointerInfo, _
  139.                                    BYVAL MouseHandle%           _
  140.                                  )
  141.  
  142.  
  143. DECLARE FUNCTION MouGetPtrPos% ( SEG MousePosition as tMousePosition, BYVAL MouseHandle% )
  144.  
  145. DECLARE FUNCTION MouSetDevStatus% ( SEG MouseStatus%, BYVAL MouseHandle% )
  146.  
  147. DECLARE FUNCTION MouGetScaleFact% ( SEG MouseScale as tMouseScale, BYVAL MouseHandle% )
  148.  
  149. DECLARE FUNCTION MouSetScaleFact% ( SEG MouseScale as tMouseScale, BYVAL MouseHandle% )
  150.  
  151. DECLARE FUNCTION MouSetPtrPos% ( SEG MousePosition as tMousePosition, BYVAL MouseHandle% )
  152.  
  153. DECLARE FUNCTION MouGetNumQueEl% ( SEG MouseQue as tMouseQue, BYVAL MouseHandle% )
  154.  
  155. DECLARE FUNCTION MouFlushQue% ( BYVAL MouseHandle% )
  156.  
  157.  
  158. SUB MouseBorder (row1, col1, row2, col2) STATIC
  159.  
  160.     ' =======================================================================
  161.     ' Sets max and min bounds on mouse movement both vertically, and
  162.     ' horizontally
  163.     ' =======================================================================
  164.  
  165.     LCol = Col1 - 1
  166.     RCol = Col2 - 1
  167.  
  168.     If LCol > RCol Then SWAP LCol, RCol
  169.  
  170.     TRow = Row1 - 1
  171.     BRow = Row2 - 1
  172.  
  173.     If TRow > BRow Then SWAP TRow, BRow
  174.  
  175.     MouseDriver 7, 0, LCol, RCol
  176.     MouseDriver 8, 0, TRow, BRow
  177.  
  178. END SUB
  179.  
  180. '| --- Modified to support OS/2 changes ---
  181. '|
  182. '| Modified MouseDriver SUB to process all the Mouse routines, since
  183. '| under DOS a single INTERRUPT all the OS/2 code is located in this
  184. '| one SUB.
  185. '|
  186. '| OS/2 has a function for each specific MOUSE event.
  187.  
  188. SUB MouseDriver (m0, m1, m2, m3) STATIC
  189.  
  190.     '| The reference to CALL INTERRUPT needs to be rewritten with
  191.     '| the OS/2 API call that provides the same functionality/information
  192.  
  193.     STATIC MouseOpen     AS Integer
  194.     STATIC MouseFound    AS Integer
  195.     STATIC MouseHandle   AS Integer
  196.     STATIC MouseLimits   AS tMouseLimits
  197.     STATIC OldMouseEvent AS tMouseEvent
  198.  
  199.     DIM MouseScale       AS tMouseScale
  200.     DIM MousePointer     AS tMousePointer
  201.     DIM MousePointerInfo AS tMousePointerInfo
  202.     DIM PtrRect          AS tPtrRect
  203.     DIM MouseEvent       AS tMouseEvent
  204.     DIM MousePosition    AS tMousePosition
  205.     DIM HiddenMouseLoc   AS tMousePosition
  206.     DIM QueEvents        AS tMouseEvent
  207.     DIM MouseQue         AS tMouseQue
  208.  
  209.     If MouseOpen = 0 Then
  210.         MouseName$ = ""
  211.         Rtn% = MouOpen% ( SSEGADD (MouseName$), MouseHandle )
  212.  
  213.         If Rtn% = 0 Then
  214.             MouseOpen   = TRUE
  215.             MouseFound  = TRUE
  216.             Rtn% = MouGetScaleFact% ( MouseScale, MouseHandle )
  217.             MouseScale.RowScale = 8
  218.             MouseScale.ColScale = 8
  219.             Rtn% = MouSetScaleFact% ( MouseScale, MouseHandle )
  220.             PtrRect.ULRow = 0
  221.             PtrRect.ULCol = 0
  222.             PtrRect.LRRow = 24
  223.             PtrRect.LRCol = 79
  224.             Rtn% = MouRemovePtr% ( PtrRect, MouseHandle )
  225.             MousePosition.Row = 12
  226.             MousePosition.Col = 40
  227.             Rtn% = MouSetPtrPos% ( MousePosition, MouseHandle )
  228.             MouseStatus% = &H0
  229.             Rtn% = MouSetDevStatus%  ( MouseStatus%, MouseHandle )
  230.             Rtn% = MouGetPtrShape%   ( MousePointer, MousePointerInfo, MouseHandle )
  231.             MousePointer.Mask1.Char = Chr$(&HFF)
  232.             MousePointer.Mask1.Attr = Chr$(3)
  233.             MousePointer.Mask2.Char = Chr$(&H0)
  234.             MousePointer.Mask2.Attr = Chr$(9)
  235.             MousePointerInfo.cb     = Len (MousePointer)
  236.             MousePointerInfo.row    = 0
  237.             MousePointerInfo.col    = 0
  238.             MousePointerInfo.colhot = 24
  239.             MousePointerInfo.rowhot = 79
  240.             Rtn% = MouSetPtrShape%   ( MousePointer, MousePointerInfo, MouseHandle )
  241.             MouseLimits.RLimit = 79
  242.             MouseLimits.LLimit = 0
  243.             MouseLimits.TLimit = 0
  244.             MouseLimits.BLimit = 24
  245.         Else
  246.             MouseOpen    = TRUE
  247.             MouseFound   = FALSE
  248.         End If
  249.     End If
  250.  
  251.     If MouseFound = FALSE then
  252.         Exit Sub
  253.     End If
  254.  
  255.     SELECT CASE m0
  256.  
  257.     CASE 0
  258.  
  259.         '| MouseInit ( 0, 0, 0, 0 )
  260.  
  261.         Rtn% = MouGetNumButtons% ( MouseButtons%, MouseHandle )
  262.         m1   = MouseButtons%
  263.  
  264.     CASE 1
  265.  
  266.         '| MouseShow ( 1, 0, 0, 0 )
  267.  
  268.         MouseStatus% = &H0
  269.         Rtn% = MouSetDevStatus%  ( MouseStatus%, MouseHandle )
  270.         Rtn% = MouDrawPtr% ( MouseHandle )
  271.  
  272.     CASE 2
  273.  
  274.         '| MouseHide ( 2, 0, 0, 0 )
  275.  
  276.         MouseStatus% = &H0100
  277.         Rtn% = MouSetDevStatus%  ( MouseStatus%, MouseHandle )
  278.  
  279.     CASE 3
  280.  
  281.         '| MousePoll ( 3, x, x, x )
  282.  
  283.         MouseWait% = 1
  284.         Rtn% = MouSynch% ( MouseWait% )
  285.         MouseWait% = 0
  286.         Rtn% = MouReadEventQue% ( MouseEvent, MouseWait%, MouseHandle )
  287.  
  288.         If MouseEvent.EventTime = 0 Then
  289.             If OldMouseEvent.EventTime = 0 Then
  290.                 Rtn% = MouGetPtrPos% ( MousePosition, MouseHandle )
  291.                 MouseEvent.Action   = OldMouseEvent.Action
  292.                 MouseEvent.MouseCol = MousePosition.col
  293.                 MouseEvent.MouseRow = MousePosition.row
  294.             Else
  295.                 MouseEvent = OldMouseEvent
  296.             End If
  297.         End If
  298.  
  299.         Rtn% = MouGetNumQueEl% ( MouseQue, MouseHandle )
  300.  
  301.         While MouseQue.Events > 1
  302.             Rtn% = MouReadEventQue% ( QueEvents, MouseWait%, MouseHandle )
  303.             Rtn% = MouGetNumQueEl% ( MouseQue, MouseHandle )
  304.         Wend
  305.  
  306.         m1 = 0
  307.  
  308.         If MouseEvent.Action and &H0004 Then   m1 = m1 + 2 ^ 0
  309.         If MouseEvent.Action and &H0010 Then   m1 = m1 + 2 ^ 1
  310.         If MouseEvent.Action and &H0040 Then   m1 = m1 + 2 ^ 2
  311.         If MouseEvent.Action and &H0002 Then   m1 = m1 + 2 ^ 0
  312.         If MouseEvent.Action and &H0008 Then   m1 = m1 + 2 ^ 1
  313.         If MouseEvent.Action and &H0020 Then   m1 = m1 + 2 ^ 2
  314.  
  315.         m2 = MouseEvent.MouseCol
  316.         m3 = MouseEvent.MouseRow
  317.  
  318.         OldMouseEvent = MouseEvent
  319.  
  320.         '| The following section of code checks to see if the mouse pointer
  321.         '| is moving out of the Horizontal and Vertical limits.
  322.  
  323.         InLimits% = FALSE
  324.  
  325.         If m2 < MouseLimits.LLimit then
  326.  
  327.             '| Set it to the min.
  328.  
  329.             InLimits% = TRUE
  330.  
  331.             MousePosition.Col = MouseLimits.LLimit
  332.             m2 = MouseLimits.LLimit
  333.         ElseIF m2 > MouseLimits.RLimit then
  334.  
  335.             '| Set it to the Max.
  336.  
  337.             InLimits% = TRUE
  338.  
  339.             MousePosition.Col = MouseLimits.RLimit
  340.             m2 = MouseLimits.RLimit
  341.         Else
  342.             MousePosition.Col = m2
  343.         End If
  344.  
  345.         If m3 < MouseLimits.TLimit then
  346.  
  347.             '| Set it to the min.
  348.  
  349.             InLimits% = TRUE
  350.  
  351.             MousePosition.Row = MouseLimits.TLimit
  352.             m3 = MouseLimits.TLimit
  353.  
  354.         ElseIF m3 > MouseLimits.BLimit then
  355.  
  356.             '| Set it to the Max.
  357.  
  358.             InLimits% = TRUE
  359.  
  360.             MousePosition.Row = MouseLimits.BLimit
  361.             m3 = MouseLimits.BLimit
  362.         Else
  363.             MousePosition.Row = m3
  364.         End If
  365.  
  366.         If InLimits% = TRUE Then
  367.             Rtn% = MouSetPtrPos ( MousePosition, MouseHandle )
  368.         End If
  369.  
  370.     CASE 7
  371.  
  372.         '| There are not LIMIT Rectangles when using the OS/2 Mouse API
  373.         '| calls, so we have to provide the limits in the code (at this
  374.         '| level)  We are setting the limits for the horizontal coordinates.
  375.  
  376.         '| We are responsible for making sure the ranges are in correct
  377.         '| order, since the INTERRUPT Service does this, not the software.
  378.  
  379.         '| This section of code helps provide the INTERRUPT Service of
  380.         '| INT 33h Function 07h "Set horizontal limits for pointer"
  381.  
  382.         If m2 > m3 then SWAP m2, m3
  383.  
  384.         MouseLimits.LLimit = m2
  385.         MouseLimits.RLimit = m3
  386.  
  387.     CASE 8
  388.  
  389.         '| There are not LIMIT Rectangles when using the OS/2 Mouse API
  390.         '| calls, so we have to provide the limits in the code (at this
  391.         '| level).  We are setting the limits for the Vertical coordinates.
  392.  
  393.         '| We are responsible for making sure the ranges are in correct
  394.         '| order, since the INTERRUPT Service does this, not the software.
  395.  
  396.         '| This section of code helps provide the INTERRUPT Service of
  397.         '| INT 33h Function 08h "Set vertical limits for pointer"
  398.  
  399.         If m2 > m3 then SWAP m2, m3
  400.  
  401.         MouseLimits.TLimit = m2
  402.         MouseLimits.BLimit = m3
  403.  
  404.     CASE ELSE
  405.  
  406.         '| UnKnown Call
  407.  
  408.     END SELECT
  409.  
  410. END SUB
  411.  
  412.  
  413. SUB MouseHide
  414.  
  415.     ' =======================================================================
  416.     ' Decrements internal cursor flag
  417.     ' =======================================================================
  418.  
  419.    MouseDriver 2, 0, 0, 0
  420.  
  421. END SUB
  422.  
  423. SUB MouseInit
  424.  
  425.     ' =======================================================================
  426.     ' Mouse driver's initialization routine
  427.     ' =======================================================================
  428.  
  429.     MouseDriver 0, 0, 0, 0
  430.  
  431. END SUB
  432.  
  433. SUB MousePoll (row, col, lButton, rButton) STATIC
  434.  
  435.     ' =======================================================================
  436.     ' Polls mouse driver, then sets parms correctly
  437.     ' =======================================================================
  438.  
  439.     MouseDriver 3, button, col, row
  440.     row = row + 1 '| row / 8 + 1
  441.     col = col + 1 '| col / 8 + 1
  442.                                                 
  443.     IF button AND 1 THEN
  444.         lButton = TRUE
  445.     ELSE
  446.         lButton = FALSE
  447.     END IF
  448.  
  449.     IF button AND 2 THEN
  450.         rButton = TRUE
  451.     ELSE
  452.         rButton = FALSE
  453.     END IF
  454.  
  455. END SUB
  456.  
  457. SUB MouseShow
  458.  
  459.     ' =======================================================================
  460.     ' Increments mouse's internal cursor flag
  461.     ' =======================================================================
  462.  
  463.     MouseDriver 1, 0, 0, 0
  464.  
  465. END SUB
  466.