Changes
Jump to navigation
Jump to search
Line 1:
Line 1:
−
− <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.
−
− 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
− 'Ansonsten viel Spaß und Erfolg mit diesem Source !
−
− 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
− Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation
− Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#..\..\..\..\WINDOWS\system32\dx7vb.dll#DirectX 7 for Visual Basic Type Library
− Module=Module1; Module1.bas
− Form=js.frm
− Startup="Jsbilder"
− HelpFile=""
− ExeName32="jsbilder_zoom_englisch_181006.exe"
− Command32=""
− Name="joystick_bilder"
− HelpContextID="0"
− CompatibleMode="0"
− MajorVer=1
− MinorVer=0
− RevisionVer=0
− AutoIncrementVer=0
− ServerSupportFiles=0
− VersionCompanyName="TUD"
− CompilationType=0
− OptimizationType=0
− FavorPentiumPro(tm)=0
− CodeViewDebugInfo=0
− NoAliasing=0
− BoundsCheck=0
− OverflowCheck=0
− FlPointCheck=0
− FDIVCheck=0
− UnroundedFP=0
− StartMode=0
− Unattended=0
− Retained=0
− ThreadPerObject=0
− MaxNumberOfThreads=1
−
− [MS Transaction Server]
− AutoRefresh=1</nowiki>
no edit summary
=== Logitech Attack 3 Controller ===
=== Logitech Attack 3 Controller ===
=== Red Joystick (Serial Based) ===
=== Red Joystick (Serial Based) ===