CodeItBetter Programming Another VB Programming Blog

'System & API - How to implement DInput for keyboard
Option Explicit
 
Public di As DirectInput8
Dim diDEV As DirectInputDevice8
Dim diState As DIKEYBOARDSTATE
 
Public aKeys(255) As Boolean
Public KeyName(255) As String
 
'Keycode constants
Global Const DIK_ESCAPE = 1
Global Const DIK_1 = 2
Global Const DIK_2 = 3
Global Const DIK_3 = 4
Global Const DIK_4 = 5
Global Const DIK_5 = 6
Global Const DIK_6 = 7
Global Const DIK_7 = 8
Global Const DIK_8 = 9
Global Const DIK_9 = 10
Global Const DIK_0 = 11
Global Const DIK_MINUS = 12
Global Const DIK_EQUALS = 13
Global Const DIK_BACKSPACE = 14
Global Const DIK_TAB = 15
Global Const DIK_Q = 16
Global Const DIK_W = 17
Global Const DIK_E = 18
Global Const DIK_R = 19
Global Const DIK_T = 20
Global Const DIK_Y = 21
Global Const DIK_U = 22
Global Const DIK_I = 23
Global Const DIK_O = 24
Global Const DIK_P = 25
Global Const DIK_LBRACKET = 26
Global Const DIK_RBRACKET = 27
Global Const DIK_RETURN = 28
Global Const DIK_LCONTROL = 29
Global Const DIK_A = 30
Global Const DIK_S = 31
Global Const DIK_D = 32
Global Const DIK_F = 33
Global Const DIK_G = 34
Global Const DIK_H = 35
Global Const DIK_J = 36
Global Const DIK_K = 37
Global Const DIK_L = 38
Global Const DIK_SEMICOLON = 39
Global Const DIK_APOSTROPHE = 40
Global Const DIK_GRAVE = 41
Global Const DIK_LSHIFT = 42
Global Const DIK_BACKSLASH = 43
Global Const DIK_Z = 44
Global Const DIK_X = 45
Global Const DIK_C = 46
Global Const DIK_V = 47
Global Const DIK_B = 48
Global Const DIK_N = 49
Global Const DIK_M = 50
Global Const DIK_COMMA = 51
Global Const DIK_PERIOD = 52
Global Const DIK_SLASH = 53
Global Const DIK_RSHIFT = 54
Global Const DIK_MULTIPLY = 55
Global Const DIK_LALT = 56
Global Const DIK_SPACE = 57
Global Const DIK_CAPSLOCK = 58
Global Const DIK_F1 = 59
Global Const DIK_F2 = 60
Global Const DIK_F3 = 61
Global Const DIK_F4 = 62
Global Const DIK_F5 = 63
Global Const DIK_F6 = 64
Global Const DIK_F7 = 65
Global Const DIK_F8 = 66
Global Const DIK_F9 = 67
Global Const DIK_F10 = 68
Global Const DIK_NUMLOCK = 69
Global Const DIK_SCROLL = 70
Global Const DIK_NUMPAD7 = 71
Global Const DIK_NUMPAD8 = 72
Global Const DIK_NUMPAD9 = 73
Global Const DIK_SUBTRACT = 74
Global Const DIK_NUMPAD4 = 75
Global Const DIK_NUMPAD5 = 76
Global Const DIK_NUMPAD6 = 77
Global Const DIK_ADD = 78
Global Const DIK_NUMPAD1 = 79
Global Const DIK_NUMPAD2 = 80
Global Const DIK_NUMPAD3 = 81
Global Const DIK_NUMPAD0 = 82
Global Const DIK_DECIMAL = 83
Global Const DIK_F11 = 87
Global Const DIK_F12 = 88
Global Const DIK_NUMPADENTER = 156
Global Const DIK_RCONTROL = 157
Global Const DIK_DIVIDE = 181
Global Const DIK_RALT = 184
Global Const DIK_HOME = 199
Global Const DIK_UP = 200
Global Const DIK_PAGEUP = 201
Global Const DIK_LEFT = 203
Global Const DIK_RIGHT = 205
Global Const DIK_END = 207
Global Const DIK_DOWN = 208
Global Const DIK_PAGEDOWN = 209
Global Const DIK_INSERT = 210
Global Const DIK_DELETE = 211
 
Public Sub InitDInput(dx As DirectX8, ByVal nHWnd As Long)
    Set di = dx.DirectInputCreate()
 
    If Err.Number <> 0 Then
        Debug.Print "Error starting Direct Input, please make sure you have DirectX installed"
        End
    End If
 
    Set diDEV = di.CreateDevice("GUID_SysKeyboard")
 
    diDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
    diDEV.SetCooperativeLevel nHWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE    'Nonexclusive because we don't use DInput for mouse
    diDEV.Acquire
    InitKeyNames
 
    Debug.Print "DInput initialized."
End Sub
 
Public Sub CheckKeys()
    'Get the current state of the keyboard
    diDEV.GetDeviceStateKeyboard diState
 
    'Scan through all the keys to check which are depressed
    For I = 1 To 211
        If diState.Key(I) <> 0 Then
            aKeys(I) = True             'If the key is pressed, set the appropriate array index to true
        Else
            aKeys(I) = False            'If the key is not pressed, set the appropriate array index to false
        End If
    Next
End Sub
 
Public Sub Destroy()
    diDEV.Unacquire
    Debug.Print "DInput destroyed."
End Sub
 
Sub InitKeyNames()
    KeyName(1) = "DIK_ESCAPE"
    KeyName(2) = "DIK_1  On main keyboard"
    KeyName(3) = "DIK_2  On main keyboard"
    KeyName(4) = "DIK_3  On main keyboard"
    KeyName(5) = "DIK_4  On main keyboard"
    KeyName(6) = "DIK_5  On main keyboard"
    KeyName(7) = "DIK_6  On main keyboard"
    KeyName(8) = "DIK_7  On main keyboard"
    KeyName(9) = "DIK_8  On main keyboard"
    KeyName(10) = "DIK_9  On main keyboard"
    KeyName(11) = "DIK_0  On main keyboard"
    KeyName(12) = "DIK_MINUS  On main keyboard"
    KeyName(13) = "DIK_EQUALS  On main keyboard"
    KeyName(14) = "DIK_BACK BACKSPACE"
    KeyName(15) = "DIK_TAB"
    KeyName(16) = "DIK_Q"
    KeyName(17) = "DIK_W"
    KeyName(18) = "DIK_E"
    KeyName(19) = "DIK_R"
    KeyName(20) = "DIK_T"
    KeyName(21) = "DIK_Y"
    KeyName(22) = "DIK_U"
    KeyName(23) = "DIK_I"
    KeyName(24) = "DIK_O"
    KeyName(25) = "DIK_P"
    KeyName(26) = "DIK_LBRACKET  ["
    KeyName(27) = "DIK_RBRACKET  ]"
    KeyName(28) = "DIK_RETURN  ENTER on main keyboard"
    KeyName(29) = "DIK_LCONTROL  Left CTRL Key"
    KeyName(30) = "DIK_A"
    KeyName(31) = "DIK_S"
    KeyName(32) = "DIK_D"
    KeyName(33) = "DIK_F"
    KeyName(34) = "DIK_G"
    KeyName(35) = "DIK_H"
    KeyName(36) = "DIK_J"
    KeyName(37) = "DIK_K"
    KeyName(38) = "DIK_L"
    KeyName(39) = "DIK_SEMICOLON"
    KeyName(40) = "DIK_APOSTROPHE"
    KeyName(41) = "DIK_GRAVE  Grave accent (`)"
    KeyName(42) = "DIK_LSHIFT  Left SHIFT"
    KeyName(43) = "DIK_BACKSLASH"
    KeyName(44) = "DIK_Z"
    KeyName(45) = "DIK_X"
    KeyName(46) = "DIK_C"
    KeyName(47) = "DIK_V"
    KeyName(48) = "DIK_B"
    KeyName(49) = "DIK_N"
    KeyName(50) = "DIK_M"
    KeyName(51) = "DIK_COMMA"
    KeyName(52) = "DIK_PERIOD  On main keyboard"
    KeyName(53) = "DIK_SLASH  Forward slash (/)on main keyboard"
    KeyName(54) = "DIK_RSHIFT  Right SHIFT"
    KeyName(55) = "DIK_MULTIPLY  Asterisk on numeric keypad"
    KeyName(56) = "DIK_LMENU  Left ALT"
    KeyName(57) = "DIK_SPACE Spacebar"
    KeyName(58) = "DIK_CAPITAL  CAPS LOCK"
    KeyName(59) = "DIK_F1"
    KeyName(60) = "DIK_F2"
    KeyName(61) = "DIK_F3"
    KeyName(62) = "DIK_F4"
    KeyName(63) = "DIK_F5"
    KeyName(64) = "DIK_F6"
    KeyName(65) = "DIK_F7"
    KeyName(66) = "DIK_F8"
    KeyName(67) = "DIK_F9"
    KeyName(68) = "DIK_F10"
    KeyName(69) = "vDIK_NUMLOCK"
    KeyName(70) = "DIK_SCROLL  SCROLL LOCK"
    KeyName(71) = "DIK_NUMPAD7"
    KeyName(72) = "DIK_NUMPAD8"
    KeyName(73) = "DIK_NUMPAD9"
    KeyName(74) = "DIK_SUBTRACT  Hyphen (minus sign) on numeric keypad"
    KeyName(75) = "DIK_NUMPAD4"
    KeyName(76) = "DIK_NUMPAD5"
    KeyName(77) = "DIK_NUMPAD6"
    KeyName(78) = "DIK_ADD  Plus sign on numeric keypad"
    KeyName(79) = "DIK_NUMPAD1"
    KeyName(80) = "DIK_NUMPAD2"
    KeyName(81) = "DIK_NUMPAD3"
    KeyName(82) = "DIK_NUMPAD0"
    KeyName(83) = "DIK_DECIMAL  Period (decimal point) on numeric keypad"
    KeyName(87) = "DIK_F11"
    KeyName(88) = "DIK_F12"
    KeyName(86) = "DIK_F13"
    KeyName(84) = "DIK_F14"
    KeyName(85) = "DIK_F15"
    KeyName(156) = "DIK_NUMPADENTER"
    KeyName(157) = "DIK_RCONTROL  Right CTRL key"
    KeyName(91) = "DIK_NUMPADCOMMA Comma on NEC PC98 numeric keypad"
    KeyName(181) = "DIK_DIVIDE  Forward slash (/)on numeric keypad"
    KeyName(183) = "DIK_SYSRQ"
    KeyName(184) = "DIK_RMENU  Right ALT"
    KeyName(199) = "DIK_HOME"
    KeyName(200) = "DIK_UP  Up arrow"
    KeyName(201) = "DIK_PRIOR  PAGE UP"
    KeyName(203) = "DIK_LEFT  Left arrow"
    KeyName(205) = "DIK_RIGHT  Right arrow"
    KeyName(207) = "DIK_END"
    KeyName(208) = "DIK_DOWN  Down arrow"
    KeyName(209) = "DIK_NEXT  PAGE DOWN"
    KeyName(210) = "DIK_INSERT"
    KeyName(211) = "DIK_DELETE"
    KeyName(219) = "DIK_LWIN  Left Windows key"
    KeyName(220) = "DIK_RWIN  Right Windows key"
    KeyName(221) = "DIK_APPS  Application key"
    KeyName(116) = "DIK_PAUSE"
End Sub
 
'How can I use this:
Private Sub Form_Load()
    ModDInput.InitDInput modDXGFX8.DirectX, Me.hWnd
    Do Until Finish = True
         If ModDInput.aKeys(DIK_F4) Then
             'F4 Pressed
         End If
        DoEvents
    Loop
End Sub