JoyStick: Difference between revisions

Jump to navigation Jump to search
← Older editNewer edit →
No edit summary
No edit summary
Line 1: Line 1:
=== Logitech Attack 3 Controller ===
=== Logitech Attack 3 Controller ===


Drivers
<nowiki> Attribute VB_Name = "Module1"
'Dieser Source stammt von http://www.vb-fun.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.


AAT Module
'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source !


Script
Option Explicit
 
Dim DX As New DirectX7
Dim DI As DirectInput
Dim diJoystick() As DirectInputDevice
Const JOYSTICKCENTERED = 32768
Dim JSButton() As Single
Dim Button() As Long
Public test
Public jpos As Integer
Public Const UNKLAR = 99
Public Const MITTE = 0
Public Const WEG = 1
Public Const HIN = 2
Public Const GANZ_WEG = 3
Public Const GANZ_HIN = 4
Public Const ANSCHLAG_WEG = 5
Public Const ANSCHLAG_HIN = 6
Public Const WEITER_HIN = 7
Public Const WEITER_WEG = 8
Public jsknopf As Boolean
Public m1, m2, v1, v2, v3, h1, h2, h3
'
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'
Public Function DInput_Init() As Boolean
    Dim Caps As DIDEVCAPS
    Dim diEnumObjects As DirectInputEnumDeviceObjects
    Dim enumDevice As DirectInputEnumDevices
    Dim i As Single
   
    On Error GoTo ErrEnd
     
    'erstelle das DirectInput-Objekt
    Set DI = DX.DirectInputCreate()
   
    'Auflistung aller angeschlossenen Joysticks einlesen
    Set enumDevice = DI.GetDIEnumDevices(DIDEVTYPE_JOYSTICK, DIEDFL_ATTACHEDONLY)
   
    If enumDevice.GetCount = 0 Then
        MsgBox "There are no Joysticks connected to this PC!", vbInformation
        Exit Function
    End If
   
    ReDim diJoystick(enumDevice.GetCount) As DirectInputDevice
    ReDim JSButton(enumDevice.GetCount) As Single
    'und nun pro Joystick
    For i = 1 To enumDevice.GetCount
        'setze Input-Objekt pro Joystick
        Set diJoystick(i) = DI.CreateDevice(enumDevice.GetItem(i).GetGuidInstance)
        'hole Produktname
        Jsbilder.List2.AddItem enumDevice.GetItem(i).GetProductName
        'setze DirectInput DatenFormat auf Joystick
        diJoystick(i).SetCommonDataFormat DIFORMAT_JOYSTICK
        'setze cooperative Level
        diJoystick(i).SetCooperativeLevel Jsbilder.hWnd, DISCL_BACKGROUND Or DISCL_EXCLUSIVE
        'hole Fähigkeiten des Joysticks
        diJoystick(i).GetCapabilities Caps
        'irgendwelche Fähigkeiten hat der Joystick hoffentlich
        If Caps.lFlags Then
            'hole Button-Auflistung vom Joystick
            Set diEnumObjects = diJoystick(i).GetDeviceObjectsEnum(DIDFT_BUTTON)
            'wieviele Button hat der Joystick
            JSButton(i) = diEnumObjects.GetCount
            ReDim Button(i, diEnumObjects.GetCount)
            diJoystick(i).Acquire
            diJoystick(i).Poll
            Set diEnumObjects = Nothing
        End If
    Next i
   
    DInput_Init = True
    Exit Function
ErrEnd:
    MsgBox "Direct Input konnte nicht initialisiert werden!" & vbCr & _
        "Anwendung wird beendet.", vbExclamation
    DInput_Init = False
End Function
 
Public Function CheckInput() As Integer
    Dim JoystickState As DIJOYSTATE
    Dim i As Single
    Dim strhilf As String
    Dim temp, jpv, j
    'On Error Resume Next
    j = 0
s1:
    j = j + 1
    'stelle Verbindung her
    diJoystick(Jsbilder.List2.ListIndex + 1).Acquire
    'mache Daten verfügbar
    diJoystick(Jsbilder.List2.ListIndex + 1).Poll
    'hole aktuelle Daten
    diJoystick(Jsbilder.List2.ListIndex + 1).GetDeviceState Len(JoystickState), JoystickState
   
    'frmMain.txt_XY.Text = "X: " & (JoystickState.x - JOYSTICKCENTERED) & vbCrLf & _
    '    "Y: " & (JoystickState.y - JOYSTICKCENTERED) & vbCrLf & _
    '    "Z: " & (JoystickState.z - JOYSTICKCENTERED)
 
    temp = 32768 - Val(JoystickState.y - JOYSTICKCENTERED)
    jpos = UNKLAR
    If temp > m1 And temp < m2 Then jpos = MITTE
    '
    If temp < m1 And temp > v1 Then jpos = HIN
    If temp > v2 And temp < v1 Then jpos = WEITER_HIN
    If temp > v3 And temp < v2 Then jpos = GANZ_HIN
    If temp < v3 Then jpos = ANSCHLAG_HIN
    '
    If temp > m2 And temp < h1 Then jpos = WEG
    If temp > h1 And temp < h2 Then jpos = WEITER_WEG
    If temp > h2 And temp < h3 Then jpos = GANZ_WEG
    If temp > h3 Then jpos = ANSCHLAG_WEG
    '
    If JoystickState.buttons(0) > 0 Then jsknopf = True Else jsknopf = False
    'stelle Verbindung her
    diJoystick(Jsbilder.List2.ListIndex + 1).Acquire
    'mache Daten verfügbar
    diJoystick(Jsbilder.List2.ListIndex + 1).Poll
    'hole aktuelle Daten
    diJoystick(Jsbilder.List2.ListIndex + 1).GetDeviceState Len(JoystickState), JoystickState
   
    'frmMain.txt_XY.Text = "X: " & (JoystickState.x - JOYSTICKCENTERED) & vbCrLf & _
    '    "Y: " & (JoystickState.y - JOYSTICKCENTERED) & vbCrLf & _
    '    "Z: " & (JoystickState.z - JOYSTICKCENTERED)
   
    temp = 32768 - Val(JoystickState.y - JOYSTICKCENTERED)
    jpv = UNKLAR
    '
    If temp > m1 And temp < m2 Then jpv = MITTE
    '
    If temp < m1 And temp > v1 Then jpv = HIN
    If temp > v2 And temp < v1 Then jpv = WEITER_HIN
    If temp > v3 And temp < v2 Then jpv = GANZ_HIN
    If temp < v3 Then jpv = ANSCHLAG_HIN
    '
    If temp > m2 And temp < h1 Then jpv = WEG
    If temp > h1 And temp < h2 Then jpv = WEITER_WEG
    If temp > h2 And temp < h3 Then jpv = GANZ_WEG
    If temp > h3 Then jpv = ANSCHLAG_WEG
    If jpos <> jpv Then jpos = UNKLAR
    If jpos = UNKLAR Then
    If j < 10 Then GoTo s1
    End If
    '
    If test Then
    Jsbilder.Label2.Visible = True
    If jpos = UNKLAR Then Jsbilder.Label2.Caption = "UNKLAR " + CStr(temp)
    If jpos = MITTE Then Jsbilder.Label2.Caption = "MITTE " + CStr(temp)
    If jpos = WEG Then Jsbilder.Label2.Caption = "WEG " + CStr(temp)
    If jpos = GANZ_WEG Then Jsbilder.Label2.Caption = "GANZ_WEG " + CStr(temp)
    If jpos = ANSCHLAG_WEG Then Jsbilder.Label2.Caption = "ANSCHLAG_WEG " + CStr(temp)
    If jpos = HIN Then Jsbilder.Label2.Caption = "HIN " + CStr(temp)
    If jpos = GANZ_HIN Then Jsbilder.Label2.Caption = "GANZ_HIN " + CStr(temp)
    If jpos = ANSCHLAG_HIN Then Jsbilder.Label2.Caption = "ANSCHLAG_HIN " + CStr(temp)
    If jpos = WEITER_WEG Then Jsbilder.Label2.Caption = "WEITER_WEG " + CStr(temp)
    If jpos = WEITER_HIN Then Jsbilder.Label2.Caption = "WEITER_HIN " + CStr(temp)
    End If
    CheckInput = jpos
End Function
 
Public Sub DInput_ControlPanel()
    'öffne Systemsteuerung
    DI.RunControlPanel Jsbilder.hWnd
End Sub
 
Public Sub DInput_Kill()
    Dim i As Single
    If Jsbilder.List2.ListCount > 0 Then
        For i = 1 To Jsbilder.List2.ListCount
            Set diJoystick(i) = Nothing
        Next i
    End If
    Set DI = Nothing
    Set DX = Nothing
End Sub</nowiki>


  <nowiki> Type=Exe
  <nowiki> Type=Exe
Retrieved from "https://tsgdoc.socsci.ru.nl/index.php/JoyStick"