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) ===