home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter11 / DirectInput / DirectInput.bas
Encoding:
BASIC Source File  |  2004-10-25  |  4.9 KB  |  188 lines
  1. Attribute VB_Name = "DirectInput"
  2.  
  3. Option Explicit
  4. Option Base 0
  5.  
  6. 'DirectInput keyboard scan codes
  7. Public Const KEY_ESC As Integer = 1
  8. Public Const KEY_LEFT As Integer = 203
  9. Public Const KEY_UP As Integer = 200
  10. Public Const KEY_RIGHT As Integer = 205
  11. Public Const KEY_DOWN As Integer = 208
  12. Public Const KEY_NUMPAD1 As Integer = 79
  13. Public Const KEY_NUMPAD2 As Integer = 80
  14. Public Const KEY_NUMPAD3 As Integer = 81
  15. Public Const KEY_NUMPAD4 As Integer = 75
  16. Public Const KEY_NUMPAD6 As Integer = 77
  17. Public Const KEY_NUMPAD7 As Integer = 71
  18. Public Const KEY_NUMPAD8 As Integer = 72
  19. Public Const KEY_NUMPAD9 As Integer = 73
  20. Public Const KEY_LSHIFT As Integer = 42
  21. Public Const KEY_RSHIFT As Integer = 54
  22. Public Const KEY_SPACE As Integer = 57
  23. Public Const KEY_LCTRL As Integer = 29
  24.  
  25. 'DirectInput variables
  26. Private dinput As DirectInput8
  27. Private diDevice As DirectInputDevice8
  28. Public diState As DIKEYBOARDSTATE
  29. Public sKeyNames(255) As String
  30.  
  31.  
  32. Public Sub InitDirectInput()
  33.     Set dinput = dx.DirectInputCreate()
  34.     If Err.Number <> 0 Then
  35.         MsgBox "Error creating DirectInput object"
  36.         End
  37.     End If
  38.     
  39. End Sub
  40.  
  41. Public Sub InitKeyboard(ByVal hwnd As Long)
  42.     'create an interface to the keyboard
  43.     Set diDevice = dinput.CreateDevice("GUID_SysKeyboard")
  44.     diDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
  45.     diDevice.SetCooperativeLevel hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
  46.     diDevice.Acquire
  47.     
  48.     'initialize the keyboard value array
  49.     InitKeyNames
  50.  
  51. End Sub
  52.  
  53. Public Sub Check_Keyboard()
  54.     Dim n As Long
  55.     
  56.     'get the list of pressed keys
  57.     diDevice.GetDeviceStateKeyboard diState
  58.     
  59.     'scan the entire list for pressed keys
  60.     For n = 0 To 255
  61.         If diState.key(n) > 0 Then
  62.             KeyPressed n    'this is located in main.bas
  63.         End If
  64.     Next
  65.     
  66. End Sub
  67.  
  68. Public Sub KillDirectInput()
  69.     diDevice.Unacquire
  70.     Set diDevice = Nothing
  71.     Set dinput = Nothing
  72.     Set dx = Nothing
  73. End Sub
  74.  
  75. Private Sub InitKeyNames()
  76.     sKeyNames(1) = "ESC"
  77.     sKeyNames(2) = "1"
  78.     sKeyNames(3) = "2"
  79.     sKeyNames(4) = "3"
  80.     sKeyNames(5) = "4"
  81.     sKeyNames(6) = "5"
  82.     sKeyNames(7) = "6"
  83.     sKeyNames(8) = "7"
  84.     sKeyNames(9) = "8"
  85.     sKeyNames(10) = "9"
  86.     sKeyNames(11) = "0"
  87.     sKeyNames(12) = "-"
  88.     sKeyNames(13) = "="
  89.     sKeyNames(14) = "BACKSPACE"
  90.     sKeyNames(15) = "TAB"
  91.     sKeyNames(16) = "Q"
  92.     sKeyNames(17) = "W"
  93.     sKeyNames(18) = "E"
  94.     sKeyNames(19) = "R"
  95.     sKeyNames(20) = "T"
  96.     sKeyNames(21) = "Y"
  97.     sKeyNames(22) = "U"
  98.     sKeyNames(23) = "I"
  99.     sKeyNames(24) = "O"
  100.     sKeyNames(25) = "P"
  101.     sKeyNames(26) = "["
  102.     sKeyNames(27) = " ]"
  103.     sKeyNames(28) = "ENTER"
  104.     sKeyNames(29) = "LCTRL"
  105.     sKeyNames(30) = "A"
  106.     sKeyNames(31) = "S"
  107.     sKeyNames(32) = "D"
  108.     sKeyNames(33) = "F"
  109.     sKeyNames(34) = "G"
  110.     sKeyNames(35) = "H"
  111.     sKeyNames(36) = "J"
  112.     sKeyNames(37) = "K"
  113.     sKeyNames(38) = "L"
  114.     sKeyNames(39) = ";"
  115.     sKeyNames(40) = "'"
  116.     sKeyNames(41) = "`"
  117.     sKeyNames(42) = "LSHIFT"
  118.     sKeyNames(43) = "\"
  119.     sKeyNames(44) = "Z"
  120.     sKeyNames(45) = "X"
  121.     sKeyNames(46) = "C"
  122.     sKeyNames(47) = "V"
  123.     sKeyNames(48) = "B"
  124.     sKeyNames(49) = "N"
  125.     sKeyNames(50) = "M"
  126.     sKeyNames(51) = ","
  127.     sKeyNames(52) = "."
  128.     sKeyNames(53) = "/"
  129.     sKeyNames(54) = "RSHIFT"
  130.     sKeyNames(55) = "NUMPAD*"
  131.     sKeyNames(56) = "LALT"
  132.     sKeyNames(57) = "SPACE"
  133.     sKeyNames(58) = "CAPSLOCK"
  134.     sKeyNames(59) = "F1"
  135.     sKeyNames(60) = "F2"
  136.     sKeyNames(61) = "F3"
  137.     sKeyNames(62) = "F4"
  138.     sKeyNames(63) = "F5"
  139.     sKeyNames(64) = "F6"
  140.     sKeyNames(65) = "F7"
  141.     sKeyNames(66) = "F8"
  142.     sKeyNames(67) = "F9"
  143.     sKeyNames(68) = "F10"
  144.     sKeyNames(69) = "NUMLOCK"
  145.     sKeyNames(70) = "SCRLLOCK"
  146.     sKeyNames(71) = "NUMPAD7"
  147.     sKeyNames(72) = "NUMPAD8"
  148.     sKeyNames(73) = "NUMPAD9"
  149.     sKeyNames(74) = "NUMPAD-"
  150.     sKeyNames(75) = "NUMPAD4"
  151.     sKeyNames(76) = "NUMPAD5"
  152.     sKeyNames(77) = "NUMPAD6"
  153.     sKeyNames(78) = "NUMPAD+"
  154.     sKeyNames(79) = "NUMPAD1"
  155.     sKeyNames(80) = "NUMPAD2"
  156.     sKeyNames(81) = "NUMPAD3"
  157.     sKeyNames(82) = "NUMPAD0"
  158.     sKeyNames(83) = "NUMPAD."
  159.     sKeyNames(87) = "F11"
  160.     sKeyNames(88) = "F12"
  161.     sKeyNames(86) = "F13"
  162.     sKeyNames(84) = "F14"
  163.     sKeyNames(85) = "F15"
  164.     sKeyNames(91) = "NUMPAD,"
  165.     sKeyNames(116) = "PAUSE"
  166.     sKeyNames(156) = "NUMPADENTER"
  167.     sKeyNames(157) = "RCONTROL"
  168.     sKeyNames(181) = "NUMPAD/"
  169.     sKeyNames(183) = "SYSRQ"
  170.     sKeyNames(184) = "RALT"
  171.     sKeyNames(199) = "HOME"
  172.     sKeyNames(200) = "UP"
  173.     sKeyNames(201) = "PAGE UP"
  174.     sKeyNames(203) = "LEFT"
  175.     sKeyNames(205) = "RIGHT"
  176.     sKeyNames(207) = "END"
  177.     sKeyNames(208) = "DOWN"
  178.     sKeyNames(209) = "PAGE DN"
  179.     sKeyNames(210) = "INSERT"
  180.     sKeyNames(211) = "DELETE"
  181.     sKeyNames(219) = "LWIN"
  182.     sKeyNames(220) = "RWIN"
  183.     sKeyNames(221) = "APPS"
  184. End Sub
  185.  
  186.  
  187.  
  188.