Changes

Jump to: navigation, search

JoySticks

7,654 bytes removed, 13:08, 31 March 2014
no edit summary
=== Logitech Attack 3 Controller ===
 
<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>
=== Red Joystick (Serial Based) ===
Anonymous user

Navigation menu