joystick.bas

breakthrough游戏(保持小球在屏幕上跳动)源程序

Attribute VB_Name = "JOYSTICK"
Option Explicit
'-------------------------------------------------------
' JOYSTICK.BAS - Joystick support routines for
'                Visual Basic.
'-------------------------------------------------------

' Joystick Device ID
Global Const JOYSTICK1 = 0
Global Const JOYSTICK2 = 1

' Joystick error return values
Global Const JOYERR_NOERROR = 0
Global Const JOYERR_PARMS = 165
Global Const MMSYSERR_NODRIVER = 6
Global Const JOYERR_UNPLUGGED = 167

' Joystick button bit-flags used by tJoyInfo.ButtonStates
Global Const JOY_BUTTON1 = &H1
Global Const JOY_BUTTON2 = &H2
Global Const JOY_BUTTON3 = &H4
Global Const JOY_BUTTON4 = &H8


' Joystick Position
Type tJoyInfo
    Xin As Integer
    Yin As Integer
    Zin As Integer
    ButtonStates As Integer
    
    ' These values are determined by the fields above.
    X As Long
    Y As Long
    Z As Long
    ButtonDown(1 To 4) As Integer
End Type

' Joystick Capabilities

Const MAXPNAMELEN = 32

Type tJoyCaps
    Mid As Integer
    Pid As Integer
    Pname As String * MAXPNAMELEN
    XminIn As Integer
    XmaxIn As Integer
    YminIn As Integer
    YmaxIn As Integer
    ZminIn As Integer
    ZmaxIn As Integer
    NumButtons As Integer
    PeriodMin As Integer
    PeriodMax As Integer

    Xmin As Long
    Xmax As Long
    Ymin As Long
    Ymax As Long
    Zmin As Long
    Zmax As Long
End Type

Global JoyCaps As tJoyCaps

' Joystick API Calls
Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As tJoyCaps, ByVal uSize As Long) As Long
Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As tJoyInfo) As Long


Function GetJoyStickPos(IDDevice As Integer, JoyInfo As tJoyInfo) As Integer
'-------------------------------------------------------
' This function is a wrapper around the joyGetPos API
' call.  That call returns coordinates as unsigned
' long integers, which VB doesn't support.  We move
' these coordinates into long values so that they
' can be easily evaluated.
'-------------------------------------------------------
Dim rc As Integer
Static NotFirstTime As Integer

    If Not NotFirstTime Then
        NotFirstTime = False
        rc = joyGetDevCaps(IDDevice, JoyCaps, Len(JoyCaps))

        If rc <> 0 Then
            GetJoyStickPos = rc
            Exit Function
        End If

        JoyCaps.Xmax = uint_to_long(JoyCaps.XmaxIn)
        JoyCaps.Xmin = uint_to_long(JoyCaps.XminIn)
        JoyCaps.Ymax = uint_to_long(JoyCaps.YmaxIn)
        JoyCaps.Ymin = uint_to_long(JoyCaps.YminIn)
        JoyCaps.Zmax = uint_to_long(JoyCaps.ZmaxIn)
        JoyCaps.Zmin = uint_to_long(JoyCaps.ZminIn)

    End If

    rc = joyGetPos(IDDevice, JoyInfo)
    GetJoyStickPos = rc

    If rc <> 0 Then Exit Function

    JoyInfo.X = uint_to_long(JoyInfo.Xin)
    JoyInfo.Y = uint_to_long(JoyInfo.Yin)
    JoyInfo.Z = uint_to_long(JoyInfo.Zin)

    JoyInfo.ButtonDown(1) = (JoyInfo.ButtonStates And JOY_BUTTON1) = JOY_BUTTON1
    JoyInfo.ButtonDown(2) = (JoyInfo.ButtonStates And JOY_BUTTON2) = JOY_BUTTON2
    JoyInfo.ButtonDown(3) = (JoyInfo.ButtonStates And JOY_BUTTON3) = JOY_BUTTON3
    JoyInfo.ButtonDown(4) = (JoyInfo.ButtonStates And JOY_BUTTON4) = JOY_BUTTON4

End Function

Function uint_to_long(uint As Integer) As Long
'-------------------------------------------------------
' Convert and unsigned integer into a long integer.
'-------------------------------------------------------
    
    uint_to_long = (CLng(uint) And &HFFFF&)
End Function