Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

Winamp Hotkey Gamepad Edition

Browsing MainForm.frm (26.67 KB)

VERSION 5.00
Begin VB.Form MainForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Winamp Hotkey Gamepad Edition"
   ClientHeight    =   5385
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5595
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "MainForm.frx":0000
   MaxButton       =   0   'False
   Picture         =   "MainForm.frx":030A
   ScaleHeight     =   5385
   ScaleWidth      =   5595
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer ThrottleTimer 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   5160
      Top             =   1920
   End
   Begin VB.Timer PreThrottleTimer 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   5160
      Top             =   1560
   End
   Begin VB.Timer PollTimer 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   5160
      Top             =   1200
   End
   Begin VB.Timer AttenuationTimer 
      Enabled         =   0   'False
      Interval        =   150
      Left            =   5160
      Top             =   840
   End
   Begin VB.Timer PostLoadTimer 
      Interval        =   4000
      Left            =   5160
      Top             =   480
   End
   Begin VB.Timer DetectTimer 
      Interval        =   3000
      Left            =   5160
      Top             =   120
   End
   Begin VB.Label lblNote 
      BackStyle       =   0  'Transparent
      Caption         =   "Designed for the Thrustmaster gamepad"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   495
      Left            =   120
      TabIndex        =   18
      Top             =   4320
      Width           =   2415
   End
   Begin VB.Line lnListStart 
      BorderColor     =   &H000000FF&
      X1              =   1440
      X2              =   1080
      Y1              =   2040
      Y2              =   2040
   End
   Begin VB.Line lnListEnd 
      BorderColor     =   &H000000FF&
      X1              =   1800
      X2              =   2040
      Y1              =   2160
      Y2              =   2160
   End
   Begin VB.Label lblListEnd 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Playlist End"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   2040
      TabIndex        =   17
      Top             =   2040
      Width           =   975
   End
   Begin VB.Label lblListStart 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Playlist Start"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   120
      TabIndex        =   16
      Top             =   1920
      Width           =   975
   End
   Begin VB.Label lblGamepadStatus 
      Alignment       =   2  'Center
      BackColor       =   &H000000FF&
      Caption         =   "No Joystick/Gamepad present!"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   2640
      TabIndex        =   15
      Top             =   5040
      Width           =   2775
   End
   Begin VB.Line lnAttenuation 
      BorderColor     =   &H000000FF&
      X1              =   1800
      X2              =   1080
      Y1              =   2640
      Y2              =   2640
   End
   Begin VB.Line lnMute 
      BorderColor     =   &H000000FF&
      X1              =   2040
      X2              =   1080
      Y1              =   2400
      Y2              =   2400
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Attenuation"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   10
      Left            =   120
      TabIndex        =   14
      Top             =   2640
      Width           =   975
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Mute"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   11
      Left            =   120
      TabIndex        =   13
      Top             =   2280
      Width           =   975
   End
   Begin VB.Line lnWAVolumeDown 
      BorderColor     =   &H000000FF&
      X1              =   1560
      X2              =   1560
      Y1              =   2280
      Y2              =   3720
   End
   Begin VB.Line lnWAVolumeUp 
      BorderColor     =   &H000000FF&
      X1              =   1680
      X2              =   1680
      Y1              =   2040
      Y2              =   3360
   End
   Begin VB.Line lnMVolumeUp 
      BorderColor     =   &H000000FF&
      X1              =   2040
      X2              =   1800
      Y1              =   1440
      Y2              =   1560
   End
   Begin VB.Line lnMVolumeDown 
      BorderColor     =   &H000000FF&
      X1              =   2160
      X2              =   2160
      Y1              =   1320
      Y2              =   1440
   End
   Begin VB.Line lnPrev 
      BorderColor     =   &H000000FF&
      X1              =   3360
      X2              =   3360
      Y1              =   2880
      Y2              =   3240
   End
   Begin VB.Line lnNext 
      BorderColor     =   &H000000FF&
      X1              =   3120
      X2              =   3120
      Y1              =   2520
      Y2              =   1800
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Master Volume Up"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   6
      Left            =   120
      TabIndex        =   12
      Top             =   1440
      Width           =   1695
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Master Volume Down"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   7
      Left            =   840
      TabIndex        =   11
      Top             =   1080
      Width           =   1695
   End
   Begin VB.Line lnRepeat 
      BorderColor     =   &H000000FF&
      X1              =   3720
      X2              =   3840
      Y1              =   2640
      Y2              =   2640
   End
   Begin VB.Line lnShuffle 
      BorderColor     =   &H000000FF&
      X1              =   3480
      X2              =   3840
      Y1              =   2280
      Y2              =   2280
   End
   Begin VB.Line lnFR 
      BorderColor     =   &H000000FF&
      X1              =   3840
      X2              =   3840
      Y1              =   1920
      Y2              =   1680
   End
   Begin VB.Line lnFF 
      BorderColor     =   &H000000FF&
      X1              =   3480
      X2              =   3480
      Y1              =   1320
      Y2              =   1800
   End
   Begin VB.Line lnStop 
      BorderColor     =   &H000000FF&
      X1              =   3120
      X2              =   3120
      Y1              =   3120
      Y2              =   4200
   End
   Begin VB.Line lnPlay 
      BorderColor     =   &H000000FF&
      X1              =   2880
      X2              =   2880
      Y1              =   2760
      Y2              =   4560
   End
   Begin VB.Label lblWAVolumeDown 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Winamp Volume Down"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   3720
      Width           =   1695
   End
   Begin VB.Label lblWAVolumeUp 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Winamp Volume Up"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   3360
      Width           =   1695
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Toggle Playlist Shuffle"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   5
      Left            =   3840
      TabIndex        =   8
      Top             =   2160
      Width           =   1695
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Toggle Playlist Repeat"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   4
      Left            =   3840
      TabIndex        =   7
      Top             =   2520
      Width           =   1695
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Fast Rewind 5 Seconds"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   9
      Left            =   3720
      TabIndex        =   6
      Top             =   1440
      Width           =   1815
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Fast Forward 5 Seconds"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   8
      Left            =   3360
      TabIndex        =   5
      Top             =   1080
      Width           =   1815
   End
   Begin VB.Label lblWAStatus 
      Alignment       =   2  'Center
      BackColor       =   &H000000FF&
      Caption         =   "Winamp Not Running!"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   5040
      Width           =   2175
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Prev Song"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   2
      Left            =   3240
      TabIndex        =   3
      Top             =   3240
      Width           =   975
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Next Song"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   3
      Left            =   2400
      TabIndex        =   2
      Top             =   1560
      Width           =   975
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Stop"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   0
      Left            =   3000
      TabIndex        =   1
      Top             =   4200
      Width           =   1215
   End
   Begin VB.Label lblButton 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Caption         =   "Play/Pause"
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   1
      Left            =   2760
      TabIndex        =   0
      Top             =   4560
      Width           =   1215
   End
   Begin VB.Menu SystrayMenu 
      Caption         =   "Systray Menu"
      Visible         =   0   'False
      Begin VB.Menu OpenMenu 
         Caption         =   "&Show"
      End
      Begin VB.Menu Blank1 
         Caption         =   "-"
      End
      Begin VB.Menu SettingMenu 
         Caption         =   "Settings"
         Begin VB.Menu RunOnStartupMenu 
            Caption         =   "&Run On Startup"
         End
      End
      Begin VB.Menu Blank2 
         Caption         =   "-"
      End
      Begin VB.Menu CloseMenu 
         Caption         =   "&Close"
      End
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Public SysTray As New SystrayIcon

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Implements DirectXEvent

Dim dx As New DirectX7
Dim di As DirectInput
Dim diDev As DirectInputDevice
Dim diDevEnum As DirectInputEnumDevices

Dim EventHandle As Long
Dim joyCaps As DIDEVCAPS
Dim js As DIJOYSTATE
Dim DiProp_Dead As DIPROPLONG
Dim DiProp_Range As DIPROPRANGE
Dim DiProp_Saturation As DIPROPLONG

Dim bVolumeInitialized As Boolean
Dim lOldVol As Long
Dim iVolStep As Integer
Dim iVolPos As Integer

Private oThrottleLbl As Object

Sub SetButton(btn As Label, bStatus As Boolean)
On Error Resume Next
Dim VolValue As Long
    If bStatus = True Then
        btn.BackColor = &HFF&
        btn.ForeColor = &HFFFFFF
    Else
        btn.BackColor = &HFFC0C0
        btn.ForeColor = &H0
    End If
    If bStatus = True Then
        If btn.Caption = lblButton(0).Caption Then WATrackStop
        If btn.Caption = lblButton(1).Caption Then
            If WAPlaybackStatus = 1 Then
                WATrackPause
            Else
                WATrackPlay
            End If
        End If
        If btn.Caption = lblButton(2).Caption Then WATrackPrev
        If btn.Caption = lblButton(3).Caption Then WATrackNext
        If btn.Caption = lblButton(4).Caption Then WAToggleRepeat
        If btn.Caption = lblButton(5).Caption Then WAToggleShuffle
        If btn.Caption = lblButton(6).Caption Then
            If bVolumeInitialized = False Then Exit Sub
            VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535) + 5
            If lOldVol > 0 Then VolValue = lOldVol + 5
            If VolValue > 100 Then VolValue = 100
            SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 65535 / 100
            lOldVol = 0
            Set oThrottleLbl = lblButton(6)
            PreThrottleTimer.Enabled = True
        End If
        If btn.Caption = lblButton(7).Caption Then
            If bVolumeInitialized = False Then Exit Sub
            VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535) - 5
            If VolValue < 0 Then VolValue = 0
            SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 65535 / 100
            Set oThrottleLbl = lblButton(7)
            PreThrottleTimer.Enabled = True
        End If
        If btn.Caption = lblButton(8).Caption Then
            WATrackFForward
            Set oThrottleLbl = lblButton(8)
            PreThrottleTimer.Enabled = True
        End If
        If btn.Caption = lblButton(9).Caption Then
            WATrackFRewind
            Set oThrottleLbl = lblButton(9)
            PreThrottleTimer.Enabled = True
        End If
        If btn.Caption = lblButton(10).Caption Then
            If bVolumeInitialized = False Then Exit Sub
            If lOldVol = 0 Then
                If Not GetVolumeValue(SetVolHmixer, SetMuteCtrl) Then
                    VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535)
                    If VolValue < 0 Then VolValue = 0
                    lOldVol = VolValue
                    SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 0.2 * 65535 / 100
                End If
            ElseIf AttenuationTimer = False Then
                If GetVolumeValue(SetVolHmixer, SetMuteCtrl) Then SetVolumeControl SetVolHmixer, SetMuteCtrl, 0
                VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535)
                If VolValue < 0 Then VolValue = 0
                iVolStep = (lOldVol - VolValue) / 6
                iVolPos = 0
                AttenuationTimer.Enabled = True
            End If
        End If
        If btn.Caption = lblButton(11).Caption Then
            If bVolumeInitialized = False Then Exit Sub
            If GetVolumeValue(SetVolHmixer, SetMuteCtrl) Then
                SetVolumeControl SetVolHmixer, SetMuteCtrl, 0
                If lOldVol > 0 Then
                    SetVolumeControl SetVolHmixer, SetVolCtrl, lOldVol * 65535 / 100
                    lOldVol = 0
                End If
            Else
                SetVolumeControl SetVolHmixer, SetMuteCtrl, 1
            End If
        End If
        If btn.Caption = lblListStart.Caption Then WAListStart
        If btn.Caption = lblListEnd.Caption Then WAListEnd
        If btn.Caption = lblWAVolumeUp.Caption Then
            WAVolRaise
            Set oThrottleLbl = lblWAVolumeUp
            PreThrottleTimer.Enabled = True
        End If
        If btn.Caption = lblWAVolumeDown.Caption Then
            WAVolLower
            Set oThrottleLbl = lblWAVolumeDown
            PreThrottleTimer.Enabled = True
        End If
    End If
End Sub


Private Sub AttenuationTimer_Timer()
Dim VolValue As Long
    If iVolPos = 6 Then
        AttenuationTimer.Enabled = False
        SetVolumeControl SetVolHmixer, SetVolCtrl, lOldVol * 65535 / 100
        lOldVol = 0
        Exit Sub
    End If
    VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535) + iVolStep
    If VolValue > 100 Then VolValue = 100
    SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 65535 / 100
    iVolPos = iVolPos + 1
End Sub

Private Sub CloseMenu_Click()
    Unload Me
End Sub

Private Sub DetectTimer_Timer()
Dim hWnd_Winamp As Long
    hWnd_Winamp = FindWindow("Winamp v1.x", vbNullString)
    If hWnd_Winamp Then
        lblWAStatus.BackStyle = 0
        lblWAStatus.ForeColor = &H80000012
        lblWAStatus.Caption = "Winamp Is Running!"
    Else
        lblWAStatus.BackStyle = 1
        lblWAStatus.ForeColor = &HFF&
        lblWAStatus.BackColor = &HFFFFFF
        lblWAStatus.Caption = "Winamp Not Running!"
    End If
End Sub

Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)
Dim i As Integer
    diDev.GetDeviceStateJoystick js
    PreThrottleTimer.Enabled = False
    DoEvents
    If Not (oThrottleLbl Is Nothing) Then Set oThrottleLbl = Nothing
    For i = LBound(js.buttons) To IIf(UBound(js.buttons) < 11, UBound(js.buttons), 11)
        If js.buttons(i) = 128 Then
            SetButton lblButton(i), True
        Else
            SetButton lblButton(i), False
        End If
    Next i
    If js.x = 0 Then SetButton lblListStart, True
    If js.x = 500 Then
        SetButton lblListStart, False
        SetButton lblListEnd, False
    End If
    If js.x = 1000 Then SetButton lblListEnd, True
    If js.y = 0 Then SetButton lblWAVolumeUp, True
    If js.y = 500 Then
        SetButton lblWAVolumeUp, False
        SetButton lblWAVolumeDown, False
    End If
    If js.y = 1000 Then SetButton lblWAVolumeDown, True
End Sub

Private Sub Form_Load()
Dim RegData As String
    SysTray.PopUpMessage = Caption + " v" & App.Major & "." & App.Minor & _
    IIf(App.Revision = 0, "", "." & App.Revision) & " By Jason's PC Software"
    SysTray.Initialize hWnd, Icon, SysTray.PopUpMessage
    SysTray.ShowIcon
    RegData = GetRegString(HKEY_LOCAL_MACHINE, AppRegRoot, "RunOnStartup")
    If RegData = "True" Or RegData = "False" Then RunOnStartupMenu.Checked = RegData
    If LCase(Command) = "-startup" Then WindowState = vbMinimized
    bVolumeInitialized = InitGetVolume
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim msgCallBackMessage As Long
    msgCallBackMessage = x / Screen.TwipsPerPixelX
    Select Case msgCallBackMessage
        Case WM_MOUSEMOVE
            SysTray.TipText = SysTray.PopUpMessage
        Case WM_LBUTTONDBLCLK
            If OpenMenu.Enabled = False Then Exit Sub
            AlwaysOnTop Me, True
            Visible = True
            AlwaysOnTop Me, False
            OpenMenu.Caption = "&Hide"
        Case WM_RBUTTONDOWN
            If OpenMenu.Enabled = False Then Exit Sub
            If Visible = False Then OpenMenu.Caption = "&Show"
            If Visible = True Then OpenMenu.Caption = "&Hide"
            PopupMenu SystrayMenu, , , , OpenMenu
    End Select
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
    If UnloadMode = 0 Or UnloadMode = 3 Then
        WindowState = vbMinimized
        Cancel = True
    Else
        dx.DestroyEvent EventHandle
        Set dx = Nothing
        Set di = Nothing
        Set diDev = Nothing
        Set diDevEnum = Nothing
    End If
End Sub

Private Sub Form_Resize()
    If WindowState = vbMinimized Then
        Visible = False
        WindowState = 0
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    SysTray.HideIcon
    End
End Sub


Private Sub OpenMenu_Click()
    If Not Visible Then AlwaysOnTop Me, True
    Visible = Not Visible
    AlwaysOnTop Me, False
End Sub


Private Sub PollTimer_Timer()
    diDev.Poll
    DoEvents
End Sub

Private Sub PostLoadTimer_Timer()
On Error GoTo ErrHandler
    PostLoadTimer.Enabled = False
    Set di = dx.DirectInputCreate()
    Set diDevEnum = di.GetDIEnumDevices(DIDEVTYPE_JOYSTICK, DIEDFL_ATTACHEDONLY)
    If diDevEnum.GetCount = 0 Then
        PostLoadTimer.Enabled = True
        Exit Sub
    Else
        lblGamepadStatus.BackStyle = 0
        lblGamepadStatus.ForeColor = &H80000012
        lblGamepadStatus.Caption = "Joystick/Gamepad initialized."
    End If
    EventHandle = dx.CreateEvent(Me)

    Set diDev = Nothing
    Set diDev = di.CreateDevice(diDevEnum.GetItem(1).GetGuidInstance)
    diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
    diDev.SetCooperativeLevel hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
    
    diDev.GetCapabilities joyCaps
    
    Call diDev.SetEventNotification(EventHandle)

    With DiProp_Dead
        .lData = 1000
        .lObj = DIJOFS_X
        .lSize = Len(DiProp_Dead)
        .lHow = DIPH_BYOFFSET
        .lObj = DIJOFS_X
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
        .lObj = DIJOFS_Y
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
    End With
    
    With DiProp_Saturation
        .lData = 9500
        .lHow = DIPH_BYOFFSET
        .lSize = Len(DiProp_Saturation)
        .lObj = DIJOFS_X
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
        .lObj = DIJOFS_Y
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
    End With
    
    With DiProp_Range
        .lHow = DIPH_DEVICE
        .lSize = Len(DiProp_Range)
        'When the joystick is centered it will
        'be half way between these two values,
        'in this case; 500
        .lMin = 0
        .lMax = 1000
        'Should you want to have a calibrate facility
        'you could use this...
    End With
    diDev.SetProperty "DIPROP_RANGE", DiProp_Range

    diDev.Acquire
    Call DirectXEvent_DXCallback(0)
    
    PollTimer.Enabled = True
    
    Exit Sub
ErrHandler:
    MsgBox "Error " & Err.Number & ": " + Err.Description, vbCritical
End Sub

Private Sub PreThrottleTimer_Timer()
    PreThrottleTimer.Enabled = False
    If Not (oThrottleLbl Is Nothing) Then
        oThrottleLbl.BackColor = &HFF00&
        oThrottleLbl.ForeColor = &HFF&
    End If
    ThrottleTimer.Enabled = True
End Sub

Private Sub RunOnStartupMenu_Click()
    RunOnStartupMenu.Checked = Not RunOnStartupMenu.Checked
    SaveRegString HKEY_LOCAL_MACHINE, AppRegRoot, "RunOnStartup", CStr(RunOnStartupMenu.Checked)
    If RunOnStartupMenu.Checked Then
        SaveRegString HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", "Winamp Hotkey", """" + LCase(App.Path + IIf(Right(App.Path, 1) <> "\", "\", "")) + App.EXEName + ".exe"" -startup"
    Else
        DeleteValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", "Winamp Hotkey"
    End If
End Sub



Private Sub ThrottleTimer_Timer()
Dim VolValue As Long
    If Not (oThrottleLbl Is Nothing) Then
        Select Case oThrottleLbl.Caption
            Case lblButton(6).Caption
                If bVolumeInitialized = False Then Exit Sub
                VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535) + 5
                If lOldVol > 0 Then VolValue = lOldVol + 5
                If VolValue > 100 Then VolValue = 100
                SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 65535 / 100
                lOldVol = 0
            Case lblButton(7).Caption
                If bVolumeInitialized = False Then Exit Sub
                VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535) - 5
                If VolValue < 0 Then VolValue = 0
                SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 65535 / 100
            Case lblButton(8).Caption: WATrackFForward
            Case lblButton(9).Caption: WATrackFRewind
            Case lblWAVolumeUp.Caption: WAVolRaise
            Case lblWAVolumeDown.Caption: WAVolLower
        End Select
    End If
End Sub


Download MainForm.frm

Back to file list


Back to project page