home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 July / Chip_1999-07_cd.bin / zkuste / VBasic / Data / Priklady / basjoy.bas next >
Encoding:
BASIC Source File  |  1996-12-14  |  3.4 KB  |  139 lines
  1. Attribute VB_Name = "basJoyStick"
  2. Option Explicit
  3.  
  4. ' Unfortunately VB 4.0 doesn't support capturing messages
  5. ' (and there's no way to trick it as with the TrayIcon)
  6. ' So we are left with poling which still can work quite
  7. ' well if written correctly.
  8.  
  9. ' Public defines and structures
  10. Public Const JOY_BUTTON1 = &H1
  11. Public Const JOY_BUTTON2 = &H2
  12. Public Const JOY_BUTTON3 = &H4
  13. Public Const JOY_BUTTON4 = &H8
  14.  
  15. Public Type JOYINFO
  16.    x As Long
  17.    Y As Long
  18.    Z As Long
  19.    Buttons As Long
  20. End Type
  21.  
  22.  
  23. ' Private defs
  24. Private Const JOYERR_BASE = 160
  25. Private Const JOYERR_NOERROR = (0)
  26. Private Const JOYERR_NOCANDO = (JOYERR_BASE + 6)
  27. Private Const JOYERR_PARMS = (JOYERR_BASE + 5)
  28. Private Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7)
  29.  
  30. Private Const MAXPNAMELEN = 32
  31.  
  32. Private Type JOYCAPS
  33.    wMid As Integer
  34.    wPid As Integer
  35.    szPname As String * MAXPNAMELEN
  36.    wXmin As Long
  37.    wXmax As Long
  38.    wYmin As Long
  39.    wYmax As Long
  40.    wZmin As Long
  41.    wZmax As Long
  42.    wNumButtons As Long
  43.    wPeriodMin As Long
  44.    wPeriodMax As Long
  45.  End Type
  46.  
  47. Private Declare Function joyGetDevCaps Lib "winmm.dll" _
  48.    Alias "joyGetDevCapsA" (ByVal id As Long, _
  49.    lpCaps As JOYCAPS, ByVal uSize As Long) As Long
  50.    
  51. Private Declare Function joyGetNumDevs Lib "winmm.dll" _
  52.    () As Long
  53.    
  54. Private Declare Function joyGetPos Lib "winmm.dll" _
  55.    (ByVal uJoyID As Long, pji As JOYINFO) As Long
  56. '
  57. '  Fills the ji structure with the minimum x, y, and z
  58. '  coordinates.  Buttons is filled with the number of
  59. '  buttons.
  60. '
  61. Public Function GetJoyMin(ByVal joy As Integer, ji As JOYINFO) As Boolean
  62.    Dim jc As JOYCAPS
  63.    
  64.    If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
  65.       GetJoyMin = False
  66.       
  67.    Else
  68.       ji.x = jc.wXmin
  69.       ji.Y = jc.wYmin
  70.       ji.Z = jc.wZmin
  71.       ji.Buttons = jc.wNumButtons
  72.    
  73.       GetJoyMin = True
  74.    End If
  75. End Function
  76. '
  77. '  Fills the ji structure with the maximum x, y, and z
  78. '  coordinates.  Buttons is filled with the number of
  79. '  buttons.
  80. '
  81. Public Function GetJoyMax(ByVal joy As Integer, ji As JOYINFO) As Boolean
  82.    Dim jc As JOYCAPS
  83.    
  84.    If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
  85.       GetJoyMax = False
  86.       
  87.    Else
  88.       ji.x = jc.wXmax
  89.       ji.Y = jc.wYmax
  90.       ji.Z = jc.wZmax
  91.       ji.Buttons = jc.wNumButtons
  92.    
  93.       GetJoyMax = True
  94.    End If
  95. End Function
  96. Public Function GetJoystick(ByVal joy As Integer, ji As JOYINFO) As Boolean
  97.    If joyGetPos(joy, ji) <> JOYERR_NOERROR Then
  98.       GetJoystick = False
  99.    Else
  100.       GetJoystick = True
  101.    End If
  102. End Function
  103.  
  104. '
  105. '  If IsConnected is False then it returns the number of
  106. '  joysticks the driver supports. (But may not be connected)
  107. '
  108. '  If IsConnected is True the it returns the number of
  109. '  joysticks present and connected.
  110. '
  111. '  IsConnected is true by default.
  112. '
  113. Public Function IsJoyPresent(Optional IsConnected As Variant) As Long
  114.    Dim ic As Boolean
  115.    Dim i As Long
  116.    Dim j As Long
  117.    Dim ret As Long
  118.    Dim ji As JOYINFO
  119.    
  120.    ic = IIf(IsMissing(IsConnected), True, CBool(IsConnected))
  121.  
  122.    i = joyGetNumDevs
  123.    
  124.    If ic Then
  125.       j = 0
  126.       Do While i > 0
  127.          i = i - 1   'Joysticks id's are 0 and 1
  128.          If joyGetPos(i, ji) = JOYERR_NOERROR Then
  129.             j = j + 1
  130.          End If
  131.       Loop
  132.    
  133.       IsJoyPresent = j
  134.    Else
  135.       IsJoyPresent = i
  136.    End If
  137.    
  138. End Function
  139.