home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectInput / ActionMapper / ActionMap.cls next >
Encoding:
Visual Basic class definition  |  2001-10-08  |  6.3 KB  |  208 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CInputMapper"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14.  
  15. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  16. '
  17. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  18. '
  19. '  File:       ActionMap.cls
  20. '  Content:    Use DirectInput action mapper to interpret input from many devices
  21. '
  22. '
  23. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  24.  
  25. Option Explicit
  26.  
  27. Dim m_NumberofSemantics As Long
  28. Dim m_diaf As DIACTIONFORMAT
  29. Dim m_DIEnum As DirectInputEnumDevices8
  30. Dim m_Devices(100) As DirectInputDevice8
  31. Dim m_DeviceTypes(100) As Long
  32. Dim m_NumDevices As Long
  33. Dim m_DI As DirectInput8
  34. Dim m_bInit As Boolean
  35. Dim m_hwnd As Long
  36. Dim m_strUserName As String
  37. Dim m_cdParams As DICONFIGUREDEVICESPARAMS
  38.  
  39. Function GetDevice(i As Long) As DirectInputDevice8
  40.     Set GetDevice = m_Devices(i)
  41. End Function
  42.  
  43. Function GetNumDevices() As Long
  44.     GetNumDevices = m_NumDevices
  45.     
  46. End Function
  47.  
  48. Function GetDInput() As DirectInput8
  49.     Set GetDInput = m_DI
  50. End Function
  51.  
  52. Function ConfigureDevices(Optional bAllowEdit = False)
  53.     ReDim m_cdParams.ActionFormats(0)
  54.     ReDim m_cdParams.UserNames(0)
  55.     
  56.     Dim i As Long
  57.     
  58.     m_cdParams.ActionFormats(0) = m_diaf
  59.     m_cdParams.FormatCount = 1
  60.     m_cdParams.UserCount = 1
  61.     m_cdParams.UserNames(0) = m_strUserName
  62.     If bAllowEdit Then
  63.         m_DI.ConfigureDevices 0, m_cdParams, DICD_EDIT
  64.     Else
  65.         m_DI.ConfigureDevices 0, m_cdParams, DICD_DEFAULT
  66.     End If
  67.     
  68.     m_diaf = m_cdParams.ActionFormats(0)
  69.     
  70.     'release existing devices
  71.     For i = 1 To m_NumDevices
  72.         If Not m_Devices(i) Is Nothing Then m_Devices(i).Unacquire
  73.         Set m_Devices(i) = Nothing
  74.     Next
  75.     
  76.     Set m_DIEnum = Nothing
  77.     
  78.     Dim ret As Long
  79.     ret = CreateDevicesFromMAP(m_hwnd, m_strUserName, m_diaf.ActionMapName, _
  80.                     m_diaf.guidActionMap, m_diaf.lGenre, m_diaf.lBufferSize, _
  81.                     m_diaf.lAxisMin, m_diaf.lAxisMax)
  82.     
  83. End Function
  84.  
  85.  
  86. '-----------------------------------------------------------------------------
  87. ' Name: CreateDevicesFromMap()
  88. ' Desc: Creation method for the class. Creates DInput, and enumerated (i.e.
  89. '       builds a list) of "suitable" devices. By "suitable", we mean devices
  90. '       that work with the DInput genre specified in the DIACTIONFORMAT
  91. '       structure.
  92. '-----------------------------------------------------------------------------
  93. Function CreateDevicesFromMAP(hWnd As Long, UserName As String, MapName As String, MapGuid As String, Genre As CONST_DIGENRE, Optional buffersize = 16, Optional AxisMin = -100, Optional AxisMax = 100) As Boolean
  94.     
  95.  
  96.     On Local Error Resume Next
  97.     Dim i As Long
  98.     
  99.     ' Copy passed in arguments for internal use.
  100.     m_hwnd = hWnd
  101.     m_strUserName = UserName
  102.     m_diaf.guidActionMap = MapGuid
  103.     m_diaf.lGenre = Genre
  104.     m_diaf.lBufferSize = buffersize
  105.     m_diaf.lAxisMax = AxisMax
  106.     m_diaf.lAxisMin = AxisMin
  107.     m_diaf.ActionMapName = MapName
  108.     
  109.     'Create DInput
  110.     Dim dx As DirectX8
  111.     Set dx = New DirectX8
  112.     Set m_DI = dx.DirectInputCreate()
  113.     Set dx = Nothing
  114.     
  115.     m_diaf.lActionCount = m_NumberofSemantics
  116.  
  117.     ' Enumerate "suitable" devices that are attached
  118.     Set m_DIEnum = m_DI.GetDevicesBySemantics(m_strUserName, m_diaf, 0)
  119.     If Err.Number <> 0 Then
  120.         CreateDevicesFromMAP = False
  121.         Exit Function
  122.     End If
  123.     
  124.     
  125.     Dim devinst As DirectInputDeviceInstance8
  126.     
  127.     For i = 1 To m_DIEnum.GetCount
  128.     
  129.         Set devinst = m_DIEnum.GetItem(i)
  130.         Set m_Devices(i) = m_DI.CreateDevice(devinst.GetGuidInstance)
  131.         m_DeviceTypes(i) = devinst.GetDevType
  132.         Set devinst = Nothing
  133.         
  134.         If m_DeviceTypes(i) = DI8DEVTYPE_MOUSE Then
  135.             Dim dipl As DIPROPLONG
  136.             dipl.lHow = DIPH_DEVICE
  137.             dipl.lData = DIPROPAXISMODE_REL
  138.             m_Devices(i).SetProperty "DIPROP_AXISMODE", dipl
  139.         End If
  140.  
  141.         ' Obtain the action to device control mapping.
  142.         m_Devices(i).BuildActionMap m_diaf, m_strUserName, 0
  143.     
  144.         ' Once actions have been mapped to the device controls the app can review
  145.         ' the mapping and may want to modify the map. When done, call
  146.         ' SetActionMap() to put the map into effect
  147.         m_Devices(i).SetActionMap m_diaf, m_strUserName, 0
  148.  
  149.         ' Set the cooperative level
  150.         m_Devices(i).SetCooperativeLevel m_hwnd, DISCL_EXCLUSIVE Or DISCL_FOREGROUND
  151.     Next
  152.  
  153.     m_NumDevices = m_DIEnum.GetCount
  154.     m_bInit = True
  155.     CreateDevicesFromMAP = True
  156. End Function
  157.  
  158.  
  159. '-----------------------------------------------------------------------------
  160. ' Name: ClearMap()
  161. ' Desc:
  162. '-----------------------------------------------------------------------------
  163. Sub ClearMap()
  164.     On Local Error Resume Next
  165.     
  166.     Dim i As Long
  167.     
  168.     m_NumberofSemantics = 0
  169.     ReDim m_diaf.ActionArray(0)
  170.     m_bInit = False
  171.         
  172.     For i = 0 To m_NumDevices
  173.         If Not m_Devices(i) Is Nothing Then
  174.             m_Devices(i).Unacquire
  175.             Set m_Devices(i) = Nothing
  176.         End If
  177.     Next
  178.     
  179.     Set m_DI = Nothing
  180.     Set m_DIEnum = Nothing
  181.     
  182.  
  183. End Sub
  184.  
  185. '-----------------------------------------------------------------------------
  186. ' Name: AddAction()
  187. ' Desc:
  188. '-----------------------------------------------------------------------------
  189. Sub AddAction(user As Long, semantic As Long, flags As Long, strName As String)
  190.     If m_bInit Then
  191.         Debug.Print "can not add actions after CreateDevicesFromMAP has been called"
  192.         Exit Sub
  193.     End If
  194.     
  195.     ReDim Preserve m_diaf.ActionArray(m_NumberofSemantics)
  196.         
  197.     With m_diaf.ActionArray(m_NumberofSemantics)
  198.         .ActionName = strName
  199.         .lAppData = user
  200.         .lFlags = flags
  201.         .lSemantic = semantic
  202.     End With
  203.     m_NumberofSemantics = m_NumberofSemantics + 1
  204. End Sub
  205.  
  206.  
  207.  
  208.