Visual Basic Game Programming for Teens/VBGPFT.cdr/sources/chapter11/KeyboardTest/Form1.frm

Visual Basic Form | 2004-10-22 | 5.3 KB | 190 lines

VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   213
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   312
   StartUpPosition =   2  'CenterScreen
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------
' Visual Basic Game Programming For Teens
' KeyboardTest Program
'------------------------------------------------------------
Option Explicit
Option Base 0
'Windows API functions and structures
Private Declare Function GetTickCount Lib "kernel32" () As Long
'program variables
Dim dx As New DirectX8
Dim dinput As DirectInput8
Dim diDevice As DirectInputDevice8
Dim diState As DIKEYBOARDSTATE
Dim sKeyNames(255) As String
Private Sub Form_Load()
    'set up the form
    Form1.Caption = "KeyboardTest"
    Form1.Show
    Set dinput = dx.DirectInputCreate()
    If Err.Number <> 0 Then
        MsgBox "Error creating DirectInput object"
        End
    End If
    'create an interface to the keyboard
    Set diDevice = dinput.CreateDevice("GUID_SysKeyboard")
    diDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
    diDevice.SetCooperativeLevel hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
    diDevice.Acquire
    'initialize the keyboard value array
    InitKeyNames
    'main game loop
    Do While True
        Check_Keyboard
        DoEvents
    Loop
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Shutdown
End Sub
Public Sub Check_Keyboard()
    Dim n As Long
    'get the list of pressed keys
    diDevice.GetDeviceStateKeyboard diState
    'scan the entire list for pressed keys
    For n = 0 To 255
        If diState.Key(n) > 0 Then
            Debug.Print n & " = " & sKeyNames(n)
        End If
    Next
    'check for ESC key
    If diState.Key(1) > 0 Then Shutdown
End Sub
Public Sub Shutdown()
    diDevice.Unacquire
    Set diDevice = Nothing
    Set dinput = Nothing
    Set dx = Nothing
    End
End Sub
Private Sub InitKeyNames()
    sKeyNames(1) = "ESC"
    sKeyNames(2) = "1"
    sKeyNames(3) = "2"
    sKeyNames(4) = "3"
    sKeyNames(5) = "4"
    sKeyNames(6) = "5"
    sKeyNames(7) = "6"
    sKeyNames(8) = "7"
    sKeyNames(9) = "8"
    sKeyNames(10) = "9"
    sKeyNames(11) = "0"
    sKeyNames(12) = "-"
    sKeyNames(13) = "="
    sKeyNames(14) = "BACKSPACE"
    sKeyNames(15) = "TAB"
    sKeyNames(16) = "Q"
    sKeyNames(17) = "W"
    sKeyNames(18) = "E"
    sKeyNames(19) = "R"
    sKeyNames(20) = "T"
    sKeyNames(21) = "Y"
    sKeyNames(22) = "U"
    sKeyNames(23) = "I"
    sKeyNames(24) = "O"
    sKeyNames(25) = "P"
    sKeyNames(26) = "["
    sKeyNames(27) = " ]"
    sKeyNames(28) = "ENTER"
    sKeyNames(29) = "LCTRL"
    sKeyNames(30) = "A"
    sKeyNames(31) = "S"
    sKeyNames(32) = "D"
    sKeyNames(33) = "F"
    sKeyNames(34) = "G"
    sKeyNames(35) = "H"
    sKeyNames(36) = "J"
    sKeyNames(37) = "K"
    sKeyNames(38) = "L"
    sKeyNames(39) = ";"
    sKeyNames(40) = "'"
    sKeyNames(41) = "`"
    sKeyNames(42) = "LSHIFT"
    sKeyNames(43) = "\"
    sKeyNames(44) = "Z"
    sKeyNames(45) = "X"
    sKeyNames(46) = "C"
    sKeyNames(47) = "V"
    sKeyNames(48) = "B"
    sKeyNames(49) = "N"
    sKeyNames(50) = "M"
    sKeyNames(51) = ","
    sKeyNames(52) = "."
    sKeyNames(53) = "/"
    sKeyNames(54) = "RSHIFT"
    sKeyNames(55) = "NUMPAD*"
    sKeyNames(56) = "LALT"
    sKeyNames(57) = "SPACE"
    sKeyNames(58) = "CAPSLOCK"
    sKeyNames(59) = "F1"
    sKeyNames(60) = "F2"
    sKeyNames(61) = "F3"
    sKeyNames(62) = "F4"
    sKeyNames(63) = "F5"
    sKeyNames(64) = "F6"
    sKeyNames(65) = "F7"
    sKeyNames(66) = "F8"
    sKeyNames(67) = "F9"
    sKeyNames(68) = "F10"
    sKeyNames(69) = "NUMLOCK"
    sKeyNames(70) = "SCRLLOCK"
    sKeyNames(71) = "NUMPAD7"
    sKeyNames(72) = "NUMPAD8"
    sKeyNames(73) = "NUMPAD9"
    sKeyNames(74) = "NUMPAD-"
    sKeyNames(75) = "NUMPAD4"
    sKeyNames(76) = "NUMPAD5"
    sKeyNames(77) = "NUMPAD6"
    sKeyNames(78) = "NUMPAD+"
    sKeyNames(79) = "NUMPAD1"
    sKeyNames(80) = "NUMPAD2"
    sKeyNames(81) = "NUMPAD3"
    sKeyNames(82) = "NUMPAD0"
    sKeyNames(83) = "NUMPAD."
    sKeyNames(87) = "F11"
    sKeyNames(88) = "F12"
    sKeyNames(86) = "F13"
    sKeyNames(84) = "F14"
    sKeyNames(85) = "F15"
    sKeyNames(91) = "NUMPAD,"
    sKeyNames(116) = "PAUSE"
    sKeyNames(156) = "NUMPADENTER"
    sKeyNames(157) = "RCONTROL"
    sKeyNames(181) = "NUMPAD/"
    sKeyNames(183) = "SYSRQ"
    sKeyNames(184) = "RALT"
    sKeyNames(199) = "HOME"
    sKeyNames(200) = "UP"
    sKeyNames(201) = "PAGE UP"
    sKeyNames(203) = "LEFT"
    sKeyNames(205) = "RIGHT"
    sKeyNames(207) = "END"
    sKeyNames(208) = "DOWN"
    sKeyNames(209) = "PAGE DN"
    sKeyNames(210) = "INSERT"
    sKeyNames(211) = "DELETE"
    sKeyNames(219) = "LWIN"
    sKeyNames(220) = "RWIN"
    sKeyNames(221) = "APPS"
End Sub