Dim dx As New DirectX8
Dim di As DirectInput8
Dim diDEV As DirectInputDevice8
Dim iKeyCounter As Integer
Dim aKeys(2) As String
Private Sub Form_Load()
Set di = dx.DirectInputCreate()
If Err.Number <> 0 Then
MsgBox "Error starting Direct Input, please make sure you have DirectX installed", vbApplicationModal
End
End If
'Create the DirectX input Device
Set di = dx.DirectInputCreate()
'Make it point to the Footpedal
Set diDEV = di.CreateDevice("{DE261610-ADC9-11D9-8001-444553540000}")
'Gather information from the device
Dim diEnumObjects As DirectInputEnumDeviceObjects
Set diEnumObjects = diDEV.GetDeviceObjectsEnum(DIDFT_ALIAS)
Dim diDevObjInstance As DirectInputDeviceObjectInstance
'populate the listbox with available buttons
Dim i As Integer
For i = 1 To diEnumObjects.GetCount
Set diDevObjInstance = diEnumObjects.GetItem(i)
Call lstDevice.AddItem(diDevObjInstance.GetName)
Next i
'Set the cooperative level for your device
Call diDEV.SetCooperativeLevel(hWnd, _
DISCL_NONEXCLUSIVE Or DISCL_FOREGROUND)
'Set the properties for the device
Dim diProp As DIPROPLONG
diProp.lHow = DIPH_DEVICE
diProp.lObj = 0
diProp.lData = 10
Call diDEV.SetProperty("DIPROP_BUFFERSIZE", diProp)
Me.Show
'Make the progrm acquire the device
diDEV.Acquire
tmrKey.Interval = 10
tmrKey.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
diDEV.Unacquire
End Sub
Function KeyNames(iNum As Integer) As String
aKeys(0) = "FWD"
aKeys(1) = "PLAY"
aKeys(2) = "REW"
If iNum < 3 Then
KeyNames = aKeys(iNum)
End If
End Function
Private Sub tmrKey_Timer()
lstKeys.Clear
'During the timer event must have some kind of event
'handler that recognizes when one of the buttons is
'pressed on the device
End Sub