Alguien sabra como programar un game pad usb en visual basic? para controlar los botones del game pad usb ,por ejemplo si se presiona la flecha hacia arriba del gamepad haga un msgbox("arrib") y haci con los demas botones del gamepad?
puedes hacerlo con KEYUP:
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp msgbox "arriba"
If KeyCode = vbKeyDown Then msgbox "abajo"
If KeyCode = 32 Then msgbox "espacio"
end sub
ahora que estuve estudiando DirectX recuerdo que con DirectInput de DirectX se puede hacer tal cosa xD de igual forma con una api no recuerdo cual xP
aca te dejo el source del ejemplo de SDK del DirectX8
nesesitas 4 listbox
lstJoySticks <-- Lista cons joysticks
lstJoyAxis <-- se ve si se oprimio arriba abajo derecha e izquierda
lstButton <-- indica que boton se oprimio
lstHat <-- no recuerdo era algo de POVs
En el formulario pega este codigo.
ASI NESESITAS LA REFERENCIA A " DirectX 8 for Visual Basic Type Library " es el archivo con nombre " dx8vb.dll "
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: FrmMain.Frm
' Content: This sample shows one way to use DirectInput with a Joystick device
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Implements DirectXEvent8
Dim dx As New DirectX8
Dim di As DirectInput8
Dim diDev As DirectInputDevice8
Dim diDevEnum As DirectInputEnumDevices8
Dim EventHandle As Long
Dim joyCaps As DIDEVCAPS
Dim js As DIJOYSTATE
Dim DiProp_Dead As DIPROPLONG
Dim DiProp_Range As DIPROPRANGE
Dim DiProp_Saturation As DIPROPLONG
Dim AxisPresent(1 To 8) As Boolean
Dim running As Boolean
Sub InitDirectInput()
Set di = dx.DirectInputCreate()
Set diDevEnum = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
If diDevEnum.GetCount = 0 Then
MsgBox "No joystick attached."
Unload Me
End If
'Add attached joysticks to the listbox
Dim i As Integer
For i = 1 To diDevEnum.GetCount
Call lstJoySticks.AddItem(diDevEnum.GetItem(i).GetInstanceName)
Next
' Get an event handle to associate with the device
EventHandle = dx.CreateEvent(Me)
Exit Sub
Error_Out:
MsgBox "Error initializing DirectInput."
Unload Me
End Sub
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
' This is called whenever there's a change in the joystick state.
' We check the new state and update the display.
Dim i As Integer
Dim ListPos As Integer
Dim S As String
If diDev Is Nothing Then Exit Sub
'' Get the device info
On Local Error Resume Next
diDev.GetDeviceStateJoystick js
If Err.Number = DIERR_NOTACQUIRED Or Err.Number = DIERR_INPUTLOST Then
diDev.Acquire
Exit Sub
End If
On Error GoTo err_out
' Display axis coordinates
ListPos = 0
For i = 1 To 8
If AxisPresent(i) Then
Select Case i
Case 1
S = "X: " & js.x
Case 2
S = "Y: " & js.y
Case 3
S = "Z: " & js.z
Case 4
S = "RX: " & js.rx
Case 5
S = "RY: " & js.ry
Case 6
S = "RZ: " & js.rz
Case 7
S = "Slider0: " & js.slider(0)
Case 8
S = "Slider1: " & js.slider(1)
End Select
lstJoyAxis.List(ListPos) = S
ListPos = ListPos + 1
End If
Next
' Buttons
For i = 0 To joyCaps.lButtons - 1
Select Case js.Buttons(i)
Case 0
lstButton.List(i) = "Button " + CStr(i + 1) + ": Up"
Case Else
lstButton.List(i) = "Button " + CStr(i + 1) + ": Down"
End Select
Next
' Hats
For i = 0 To joyCaps.lPOVs - 1
lstHat.List(i) = "POV " + CStr(i + 1) + ": " + CStr(js.POV(i))
Next
Me.Caption = "Joystick Sample: Available"
Exit Sub
err_out:
MsgBox Err.Description & " : " & Err.Number, vbApplicationModal
End
End Sub
Private Sub Form_Load()
running = True
InitDirectInput
End Sub
Private Sub Form_Unload(cancel As Integer)
On Local Error Resume Next
If EventHandle <> 0 Then dx.DestroyEvent EventHandle
running = False
'Unacquire if we are holding a device
If Not diDev Is Nothing Then
diDev.Unacquire
End If
DoEvents
End
End Sub
Private Sub lstJoySticks_Click()
On Local Error Resume Next
Call CLRLISTS
'Unacquire the current device
'if we are holding a device
If Not diDev Is Nothing Then
diDev.Unacquire
End If
'Create the joystick device
Set diDev = Nothing
Set diDev = di.CreateDevice(diDevEnum.GetItem(lstJoySticks.ListIndex + 1).GetGuidInstance)
diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
' Find out what device objects it has
diDev.GetCapabilities joyCaps
Call IdentifyAxes(diDev)
' Ask for notification of events
Call diDev.SetEventNotification(EventHandle)
' Set deadzone for X and Y axis to 10 percent of the range of travel
With DiProp_Dead
.lData = 1000
.lHow = DIPH_BYOFFSET
.lObj = DIJOFS_X
diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
.lObj = DIJOFS_Y
diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
End With
' Set saturation zones for X and Y axis to 5 percent of the range
With DiProp_Saturation
.lData = 9500
.lHow = DIPH_BYOFFSET
.lObj = DIJOFS_X
diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
.lObj = DIJOFS_Y
diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
End With
SetPropRange
diDev.Acquire
Me.Caption = "Joystick Sample: Querying Properties"
' Get the list of current properties
' USB joysticks wont call this callback until you play with the joystick
' so we call the callback ourselves the first time
DirectXEvent8_DXCallback 0
' Poll the device so that events are sure to be signaled.
' Usually this would be done in Sub Main or in the game rendering loop.
While running = True
DoEvents
diDev.Poll
Wend
End Sub
Sub SetPropRange()
' NOTE Some devices do not let you set the range
On Local Error Resume Next
' Set range for all axes
With DiProp_Range
.lHow = DIPH_DEVICE
.lMin = 0
.lMax = 10000
End With
diDev.SetProperty "DIPROP_RANGE", DiProp_Range
End Sub
Sub CLRLISTS()
lstJoyAxis.Clear
lstButton.Clear
lstHat.Clear
End Sub
Sub IdentifyAxes(diDev As DirectInputDevice8)
' It's not enough to count axes; we need to know which in particular
' are present.
Dim didoEnum As DirectInputEnumDeviceObjects
Dim dido As DirectInputDeviceObjectInstance
Dim i As Integer
For i = 1 To 8
AxisPresent(i) = False
Next
' Enumerate the axes
Set didoEnum = diDev.GetDeviceObjectsEnum(DIDFT_AXIS)
' Check data offset of each axis to learn what it is
Dim sGuid As String
For i = 1 To didoEnum.GetCount
Set dido = didoEnum.GetItem(i)
sGuid = dido.GetGuidType
Select Case sGuid
Case "GUID_XAxis"
AxisPresent(1) = True
Case "GUID_YAxis"
AxisPresent(2) = True
Case "GUID_ZAxis"
AxisPresent(3) = True
Case "GUID_RxAxis"
AxisPresent(4) = True
Case "GUID_RyAxis"
AxisPresent(5) = True
Case "GUID_RzAxis"
AxisPresent(6) = True
Case "GUID_Slider"
AxisPresent(8) = True
AxisPresent(7) = True
End Select
Next
End Sub
P.D.: Se puede hacer un KeyLogger efectivo con DirectX (igual con DirectInput) xP jejeje... la desventaja es que se nesesita una dependecia ¬¬# según la Version del DirectX usado, aun que tiene arreglo usando el coco xP ¡!.
La api no la recuerdo jejeje... consulta la API-Guide.¡! xP
Saludos
Cita de: CICOLO_111234 en 21 Diciembre 2008, 08:27 AM
puedes hacerlo con KEYUP:
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp msgbox "arriba"
If KeyCode = vbKeyDown Then msgbox "abajo"
If KeyCode = 32 Then msgbox "espacio"
end sub
Sabes lo que es un Game Pad xP es un control como los volantes o el control de la PS3 pero para PC xP eso es una Game Pad, mas no el teclado ¬¬"...¡!
Edito--->
aqui tienes las 3 apis que nesesitas para el Joystick o GamePad que a mi parecer son lo mismo xd
joyGetDevCaps
joyGetNumDevs
joyGetPos
Mas Info en: http://allapi.mentalis.org/apilist/j.shtml
El ejemplo con Apis de la pagina ya mensionada.
' defines and structures
Const JOY_BUTTON1 = &H1
Const JOY_BUTTON2 = &H2
Const JOY_BUTTON3 = &H4
Const JOY_BUTTON4 = &H8
Const JOYERR_BASE = 160
Const JOYERR_NOERROR = (0)
Const JOYERR_NOCANDO = (JOYERR_BASE + 6)
Const JOYERR_PARMS = (JOYERR_BASE + 5)
Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7)
Const MAXPNAMELEN = 32
Const JOYSTICKID1 = 0
Const JOYSTICKID2 = 1
Private Type JOYINFO
X As Long
Y As Long
Z As Long
Buttons As Long
End Type
Private Type JOYCAPS
wMid As Integer
wPid As Integer
szPname As String * MAXPNAMELEN
wXmin As Long
wXmax As Long
wYmin As Long
wYmax As Long
wZmin As Long
wZmax As Long
wNumButtons As Long
wPeriodMin As Long
wPeriodMax As Long
End Type
Private Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long
Private Declare Function joyGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFO) As Long
Private Function GetJoystick(ByVal joy As Integer, JI As JOYINFO) As Boolean
If joyGetPos(joy, JI) <> JOYERR_NOERROR Then
GetJoystick = False
Else
GetJoystick = True
End If
End Function
' If IsConnected is False then it returns the number of
' joysticks the driver supports. (But may not be connected)
'
' If IsConnected is True the it returns the number of
' joysticks present and connected.
'
' IsConnected is true by default.
Private Function IsJoyPresent(Optional IsConnected As Variant) As Long
Dim ic As Boolean
Dim i As Long
Dim j As Long
Dim ret As Long
Dim JI As JOYINFO
ic = IIf(IsMissing(IsConnected), True, CBool(IsConnected))
i = joyGetNumDevs
If ic Then
j = 0
Do While i > 0
i = i - 1 'Joysticks id's are 0 and 1
If joyGetPos(i, JI) = JOYERR_NOERROR Then
j = j + 1
End If
Loop
IsJoyPresent = j
Else
IsJoyPresent = i
End If
End Function
' Fills the ji structure with the minimum x, y, and z
' coordinates. Buttons is filled with the number of
' buttons.
Private Function GetJoyMin(ByVal joy As Integer, JI As JOYINFO) As Boolean
Dim jc As JOYCAPS
If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
GetJoyMin = False
Else
JI.X = jc.wXmin
JI.Y = jc.wYmin
JI.Z = jc.wZmin
JI.Buttons = jc.wNumButtons
GetJoyMin = True
End If
End Function
' Fills the ji structure with the maximum x, y, and z
' coordinates. Buttons is filled with the number of
' buttons.
Private Function GetJoyMax(ByVal joy As Integer, JI As JOYINFO) As Boolean
Dim jc As JOYCAPS
If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
GetJoyMax = False
Else
JI.X = jc.wXmax
JI.Y = jc.wYmax
JI.Z = jc.wZmax
JI.Buttons = jc.wNumButtons
GetJoyMax = True
End If
End Function
Private Sub Form_Paint()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim JInfo As JOYINFO
'Clear the form
Me.Cls
'Print the information to the form
Me.Print "Number of joysticks the driver supports:" + Str$(IsJoyPresent(False))
Me.Print "Number of connected joysticks:" + Str$(IsJoyPresent(True))
GetJoystick JOYSTICKID1, JInfo
Me.Print "Number of buttons:" + Str$(JInfo.Buttons)
GetJoyMax JOYSTICKID1, JInfo
Me.Print "Max X:" + Str$(JInfo.X)
Me.Print "Max Y:" + Str$(JInfo.Y)
Me.Print "Max Z:" + Str$(JInfo.Z)
GetJoyMin JOYSTICKID1, JInfo
Me.Print "Min X:" + Str$(JInfo.X)
Me.Print "Min Y:" + Str$(JInfo.Y)
Me.Print "Min Z:" + Str$(JInfo.Z)
End Sub
gracias por la ayuda xD...