Changes

Jump to navigation Jump to search

JoySticks (view source)

Revision as of 15:04, 31 March 2014

6,743 bytes added ,  15:04, 31 March 2014
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
Anonymous user
Retrieved from "http://tsgdoc.socsci.ru.nl/index.php/Special:MobileDiff/180"

Navigation menu