Changes

Jump to: navigation, search

JoySticks

6,743 bytes added, 13:04, 31 March 2014
no edit summary
=== 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
Anonymous user

Navigation menu