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