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

joyGetDevCaps
joyGetNumDevs
joyGetPos

' 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
 

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

dim variable as string ' Si cambias el tipo de la funcion sacar de string a otro es recomendable cambiar igualmente el tipo de esta vable a la misma para evitarte errores futuros si ocurriesen.
 
Private Sub Form_Load()
variable = SacaR(10, 10)
variable=iif (variable=-1,"",variable)
MsgBox variable
 
variable = SacaR(val(text1.text), val(text2.text))
variable=iif (variable=-1,"",variable)
MsgBox variable
End Sub
 
' Fin
Function SacaR(ByVal num1 As Long, ByVal num2 As Long) As Long ' si el numero es muy grande cambia el long por double aun que no creoq ue tengas problemas con long
    Dim tmp As Long'Si hay desvordamiento o error con el tipo cambia a Double xP
    If num1 = 0 And num2 = 0 Then GoTo Error:
    If num1 >= num2 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num1 / num2
    ElseIf num2 >= num1 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num2 / num1
    Else ' no creo que esta parte se ejecute pero prevengo xP
Error:
        SacaR = -1 ' usa -1 para identificar este error, ya que una divicion siempre dara numero positivos ademas que no cumple lo que pides.
        Exit Function ' sale e ignoa el resto del codigo por debajo de esta linea pudo ser ext sub solo si fuese un proceso simple que no devuelve anda como los eventos de un boton al ser llamados y tratados de almacenar en una variable, marcara error.
    End If
    SacaR = 100 - tmp
End Function
 

Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text4.Text = 100 - Val(Text3.Text)
        SendKeys "{tab}"
    End If
 
    ' Ve ese convierte con la function val cualquier texto a numero)
    ' De la misma manera se puede convertir un numero a texto con la Funcion STR() qu seria la inversa a VAL() o a INT() (cabe decir que int() solo da numeros completos no decimales y es integer xp)
    If val(Text3.Text) = 0 Then ------------> aqui me da el error
        Text4.Text = 0
    Else
        If Text3.Text = "" Then
            Text4.Text = ""
        End If
    End If
End Sub
 

Function SacaR(num1 As String, num2 As String)
Dim total As String
If num1 >= num2 Then
SacaR = num1 / num2
total = 100 - SacaR
MsgBox total
ElseIf num2 >= num1 Then
 
SacaR = num2 / num1
total = 100 - SacaR
MsgBox total
End If
End Function

dim variable as long ' Si cambias el tipo de la funcion sacar de long a otro es recomendable cambiar igualmente el tipo de esta vable a la misma para evitarte errores futuros si ocurriesen.
 
Private Sub Form_Load()
variable = SacaR(10, 10)
MsgBox variable
 
variable = SacaR(val(text1.text), val(text2.text))
MsgBox variable
End Sub
 
' Fin
Function SacaR(ByVal num1 As Long, ByVal num2 As Long) As Long ' si el numero es muy grande cambia el long por double aun que no creoq ue tengas problemas con long
    Dim tmp As Long'Si hay desvordamiento o error con el tipo cambia a Double xP
    If num1 = 0 And num2 = 0 Then GoTo Error:
    If num1 >= num2 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num1 / num2
    ElseIf num2 >= num1 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num2 / num1
    Else ' no creo que esta parte se ejecute pero prevengo xP
Error:
        SacaR = -1 ' usa -1 para identificar este error, ya que una divicion siempre dara numero positivos ademas que no cumple lo que pides.
        Exit Function ' sale e ignoa el resto del codigo por debajo de esta linea pudo ser ext sub solo si fuese un proceso simple que no devuelve anda como los eventos de un boton al ser llamados y tratados de almacenar en una variable, marcara error.
    End If
    SacaR = 100 - tmp
End Function