Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing vb/MainMod.bas (4.28 KB)
Attribute VB_Name = "MainMod"
Private Const GWL_WNDPROC = (-4)
Private Const WM_USER = &H400
Private KeyboardState(0 To 255) As Byte
Public AppWnd As Long
Public Const AppRegRoot = "Software\Winamp Hotkey Ex\"
Public Declare Function SetHook Lib "wahotkeyex.dll" (ByVal hWnd As Long) As Long
Public Declare Function RemoveHook Lib "wahotkeyex.dll" () As Long
Private Const VK_CONTROL = &H11
Private Const VK_SHIFT = &H10
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpbKeyState As Byte, lpwTransKey As Long, ByVal fuState As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private PrevWindowProc As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Sub Main()
Dim hMod As Long
If App.PrevInstance Then
MsgBox "Winamp Hotkey Ex is already running.", vbInformation
End
End If
hMod = LoadLibrary("wahotkeyex.dll")
If hMod = 0 Then
MsgBox "Winamp Hotkey Ex requires wahotkeyex.dll to run.", vbCritical
End
End If
FreeLibrary hMod
MainForm.Show
AppWnd = MainForm.hWnd
PrevWindowProc = SetWindowLong(AppWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnSubclass()
RemoveHook
SetWindowLong AppWnd, GWL_WNDPROC, PrevWindowProc
End Sub
Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If hWnd = AppWnd Then
If uMsg = WM_USER Then
If (lParam And &H80000000) = 0 Then
Dim RetVal As Long
Dim KeyAscii As Long
If GetKeyboardState(KeyboardState(0)) <> 0 Then
RetVal = ToAscii(wParam, lParam, KeyboardState(0), KeyAscii, 0)
If RetVal = 0 Then
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Select Case wParam
Case vbKeyF1
If WAPlaybackStatus = 0 Then
WATrackPlay
ElseIf WAPlaybackStatus = 1 Then
WATrackPause
ElseIf WAPlaybackStatus = 2 Then
WATrackPlay
ElseIf WAPlaybackStatus = 3 Then
WATrackPlay
End If
Case vbKeyF2
WATrackStop
Case vbKeyF3
WATrackNext
Case vbKeyF4
WATrackPrev
Case vbKeyF5
WAToggleRepeat
Case vbKeyF6
WAToggleShuffle
Case vbKeyF10
WASaveSongTitle
End Select
ElseIf GetAsyncKeyState(VK_CONTROL) < 0 Then
Select Case wParam
Case vbKeyLeft
WATrackFRewind
Case vbKeyRight
WATrackFForward
End Select
End If
End If
End If
End If
End If
End If
WindowProc = CallWindowProc(PrevWindowProc, hWnd, uMsg, wParam, lParam)
End Function