Keskustelu: Ohjelmointikysymykset: VB6: VB joystick

Dim y, yg As Long
Dim start As Long
Dim status, i As Integer
Dim PortBits(8) As Integer
Dim PortNum As Long
Dim r As Long
Dim temp As Long
Dim xmax As Long
Dim xmin As Long
Dim xratg As Double
Dim ymax As Long
Dim ymin As Long
Dim yratg As Double
Dim formh As Long
Dim formw As Long
Dim ji As JOYINFOEX
Dim caps As JOYCAPS     ' joystick capabilities
Dim rc As Long

Private Sub Form_Load()
 ji.dwSize = Len(ji)
    ji.dwFlags = JOY_RETURNALL

    ' Get the current joystick data
    rc = joyGetPosEx(JOYSTICKID1, ji)

'Lomakkeelle:
'1 Timer kontrolli (Timer1)
'2 Labellia (Label1 & Label2)

Private Sub Form_Load()

   If StartJoystick Then
      Timer1.Interval = 250 'millisekuntia
      Timer1.Eanbled = True
   Else
      MsgBox "No JoyStick control found!"
   End If

End If

Private Sub Timer1_Timer()

   PollJoystick

   Dim i As Integer

   DoEvents
   For i JoyButtons(15)
      'Testi...
      If JoyButtons(i) Then
         Label1.Caption = "JoyButton" & Cstr(i)
         Label2.Caption = "X=" & CurrentJoyX & " Y=" & CurrentJoyY
      End If
   Next i

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   Timer1.Enabled = False
End Sub

'Module1
Public Declare Function joyGetPosEx Lib "winmm.dll" _
(ByVal uJoyID As Long, pji As JOYINFOEX) As Long

Public Declare Function joyGetDevCapsA Lib "winmm.dll" _
(ByVal uJoyID As Long, pjc As JOYCAPS, ByVal cjc As Long) As Long

Public Type JOYCAPS
   wMid As Integer
   wPid As Integer
   szPname As String * 32
   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
   wRmin As Long
   wRmax As Long
   wUmin As Long
   wUmax As Long
   wVmin As Long
   wVmax As Long
   wCaps As Long
   wMaxAxes As Long
   wNumAxes As Long
   wMaxButtons As Long
   szRegKey As String * 32
   szOEMVxD As String * 260
End Type

Public Type JOYINFOEX
   dwSize As Long
   dwFlags As Long
   dwXpos As Long
   dwYpos As Long
   dwZpos As Long
   dwRpos As Long
   dwUpos As Long
   dwVpos As Long
   dwButtons As Long
   dwButtonNumber As Long
   dwPOV As Long
   dwReserved1 As Long
   dwReserved2 As Long
End Type

Public JoyNum As Long
Public MYJOYEX As JOYINFOEX
Public MYJOYCAPS As JOYCAPS
Public CenterX As Long
Public CenterY As Long
Public JoyButtons(15) as Boolean
Public CurrentJoyX As Long
Public CurrentJoyY As Long

Public Function StartJoystick( _
Optional ByVal JoystickNumber As Long = 0) As Boolean

   JoyNum = JoystickNumber

   'Get joystick info
   If joyGetDevCapsA(JoyNum, MYJOYCAPS, 404) <> 0 Then
         StartJoystick = False
   Else
      Call joyGetPosEx(JoyNum, MYJOYEX)
      CenterX = MYJOYEX.dwXpos
      CenterY = MYJOYEX.dwYpos
      StartJoystick = True
   End If

End Function

Public Sub PollJoystick()

   Dim i As Long
   Dim t As Long

   MYJOYEX.dwSize = 64
   MYJOYEX.dwFlags = 255

   ' Get the joystick information
   Call joyGetPosEx(JoyNum, MYJOYEX)

   t = MYJOYEX.dwButtons
   For i = 15 To 0 Step -1
         JoyButtons(i) = False
         If (2 ^ i) <= t Then
            t = t - (2 ^ i)
            JoyButtons(i) = True
         End If
   Next i

   CurrentJoyX = MYJOYEX.dwXpos
   CurrentJoyY = MYJOYEX.dwYpos

End Sub