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