Game Pad plz

[visualfree]

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?

[CICOLO_111234]

puedes hacerlo con KEYUP:

Código [Seleccionar] Expandir

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


[BlackZeroX]

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 "

Código (vb) [Seleccionar] Expandir



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  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

[BlackZeroX]

puedes hacerlo con KEYUP:

Código [Seleccionar] Expandir

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

Código [Seleccionar] Expandir


joyGetDevCaps
joyGetNumDevs
joyGetPos

Mas Info en:     http://allapi.mentalis.org/apilist/j.shtml

El ejemplo con Apis de la pagina ya mensionada.

Código (vb) [Seleccionar] Expandir


' 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


[visualfree]

gracias por la ayuda xD...