home *** CD-ROM | disk | FTP | other *** search
/ Microsoft DirectX SDK 7.0 / Dx7.bin / DXF / samples / multimedia / vbsamples / dinput / src / scrawlb / modmain.bas < prev    next >
Encoding:
BASIC Source File  |  1999-04-15  |  4.5 KB  |  122 lines
  1. Attribute VB_Name = "modMain"
  2. ' Scrawl
  3. ' DirectInput Sample
  4. '
  5. ' This sample application demonstrates use of the mouse in exclusive mode and how to use
  6. ' event notification for retrieving input data.
  7. '
  8. ' Hold down the left button to draw. Click the right button or press the AppMenu key
  9. ' to bring up a context menu.
  10. '
  11. ' An important issue in using exclusive mode is being able to release and reacquire the mouse
  12. ' as needed, so that the system cursor can be used. Any exclusive-mode app is forced to release
  13. ' the mouse when the user switches to another window by Alt+Tab. In addition, Scrawl surrenders
  14. ' the mouse so that the user can navigate the context menu. Reacquisition occurs in the
  15. ' MouseMove event, which is called only when Windows has the mouse.
  16. '
  17. ' The context menu allows the user to set the mouse sensitivity, since DirectInput ignores any
  18. ' such settings in Control Panel.
  19. '
  20. ' Choosing Suspend from the menu releases the system cursor and prevents
  21. ' the application from reacquiring till the user clicks on the client area.
  22. '
  23. ' The sample also demonstrates how to subclass a window in order to intercept Windows messages
  24. ' that are not otherwise available in a Visual Basic app. In this case, we want to get the
  25. ' WM_ENTERMENULOOP message, so that we can release the mouse and get the
  26. ' system cursor when the user opens the system menu by pressing Alt+Spacebar. Note that
  27. ' subclassing can make debugging difficult. If you want to play around with this code and debug it,
  28. ' comment out the indicated line in Sub Main.
  29.  
  30. Option Explicit
  31.  
  32. Public objDX As New DirectX7
  33. Public objDXEvent As DirectXEvent
  34. Public objDI As DirectInput
  35. Public objDIDev As DirectInputDevice
  36.  
  37. Public g_cursorx As Long
  38. Public g_cursory As Long
  39. Public g_Sensitivity
  40. Public Const BufferSize = 10
  41.  
  42. Public EventHandle As Long
  43. Public Drawing As Boolean
  44. Public Suspended As Boolean
  45.  
  46. Public procOld As Long
  47.  
  48. ' Windows API declares and constants
  49.  
  50. Public Const GWL_WNDPROC = (-4)
  51. Public Const WM_ENTERMENULOOP = &H211
  52. Public Const WM_EXITMENULOOP = &H212
  53. Public Const WM_SYSCOMMAND = &H112
  54.  
  55. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  56. Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
  57. Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  58. Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  59. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  60. Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  61.  
  62. Public Type POINTAPI
  63.         x As Long
  64.         y As Long
  65. End Type
  66.  
  67.  
  68. Sub Main()
  69.  
  70.   ' Show the main form first so we can use its window handle
  71.   frmCanvas.Show
  72.   
  73.   ' Comment out the following line if you want to do any debugging. It subclasses
  74.   ' the drawing window so that we can intercept Windows messages.
  75.   procOld = SetWindowLong(frmCanvas.hWnd, GWL_WNDPROC, AddressOf SysMenuProc)
  76.  
  77.   ' Initialize our private cursor
  78.   g_cursorx = frmCanvas.ScaleWidth \ 2
  79.   g_cursory = frmCanvas.ScaleHeight \ 2
  80.   g_Sensitivity = 2
  81.   frmCanvas.mnuSpeed2.Checked = True
  82.   
  83.   ' Create DirectInput and set up the mouse
  84.   Set objDI = objDX.DirectInputCreate
  85.   Set objDIDev = objDI.CreateDevice("guid_SysMouse")
  86.   Call objDIDev.SetCommonDataFormat(DIFORMAT_MOUSE)
  87.   Call objDIDev.SetCooperativeLevel(frmCanvas.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
  88.   
  89.   ' Set the buffer size
  90.   Dim diProp As DIPROPLONG
  91.   diProp.lHow = DIPH_DEVICE
  92.   diProp.lObj = 0
  93.   diProp.lData = BufferSize
  94.   diProp.lSize = Len(diProp)
  95.   Call objDIDev.SetProperty("DIPROP_BUFFERSIZE", diProp)
  96.  
  97.   ' Ask for notifications
  98.   
  99.   EventHandle = objDX.CreateEvent(frmCanvas)
  100.   Call objDIDev.SetEventNotification(EventHandle)
  101.   
  102.   ' Acquire the mouse
  103.   frmCanvas.AcquireMouse
  104.   
  105. End Sub
  106.  
  107. Public Function SysMenuProc(ByVal hWnd As Long, ByVal iMsg As Long, _
  108.         ByVal wParam As Long, ByVal lParam As Long) As Long
  109.  
  110. ' This procedure intercepts Windows messages and looks for any that might encourage us
  111. ' to Unacquire the mouse.
  112.  
  113.   If iMsg = WM_ENTERMENULOOP Then
  114.     objDIDev.Unacquire
  115.     frmCanvas.SetSystemCursor
  116.   End If
  117.   
  118.   ' Call the default window procedure
  119.   SysMenuProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
  120.  
  121. End Function
  122.