Option Explicit

Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Public Const SMTO_BLOCK = &H1
Public Const WM_USER = &H400
Public Const WM_COMMAND = &H111
Public Const IPC_GETVERSION = 0
Public Const IPC_PLAYFILE = 100
Public Const IPC_DELETE = 101
Public Const IPC_STARTPLAY = 102
'...
' ca. 15 weitere Konstanten sowie Erläuterungen im Download

Public Enum WinAmpCmd
  WINAMP_QUIT = 40001
  WINAMP_OPEN_FILE_TO_PLAY = 40029
  WA_TOGGLEEQ = 40036
  WINAMP_TIME_REMAINING = 40037
  WINAMP_TIME_ELAPSED = 40038
  WINAMP_OPTIONS_PLEDIT = 40040
  ' ...
  ' ca. weitere 50 Konstanten sowie Erläuterungen im Download
End Enum

Public WinampHandle As Long

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

Public Declare Function GetWindowText Lib "user32" Alias _
      "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString _
      As String, ByVal cch As Long) As Long

Public Declare Function PostMessage Lib "user32" Alias _
      "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
      ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias _
      "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
      ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd _
      As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
      ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
      ByVal wFlags As Long) As Long

Public Declare Function SendMessageTimeout Lib "user32" Alias _
      "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg _
      As Long, ByVal wParam As Long, ByVal lParam As Long, _
      ByVal fuFlags As Long, ByVal uTimeout As Long, _
      lpdwResult As Long) As Long

Public Function GetHWnd()
  GetHWnd = FindWindow("Winamp v1.x", vbNullString)
End Function

Public Sub SendCommand(cmd As WinAmpCmd)
  PostMessage modMain.WinampHandle, WM_COMMAND, cmd, 0
End Sub

Public Function GetVersion() As String
  Dim Success As Long
  Dim ReturnValue As Long
  Dim tmp As String

  Success = SendMessageTimeout(WinampHandle, WM_USER, 0, _
            IPC_GETVERSION, SMTO_BLOCK, 1000, ReturnValue)
  If Success <> 1 Then Exit Function
  tmp$ = LTrim(Str(Hex(ReturnValue)))
  GetVersion = Left$(tmp$, 1) & "." & Right$(tmp$, Len(tmp$) - 1)
End Function

Public Function GetTitle() As String
  On Error Resume Next
  Dim strTitle As String
  strTitle = String$(2048, Chr$(32))

  GetWindowText WinampHandle, strTitle, Len(strTitle)
  strTitle = Trim$(Left$(strTitle, InStr(strTitle, "- Winamp") - 1))
  GetTitle = Trim$(mid$(strTitle, InStr(strTitle, chr$(32)), _
     Len(strTitle) - 1))
End Function

Option Explicit
Dim Mute As Integer

Private Sub cmdMute_Click()
  If Mute = 0 Then
    Mute = SendMessage(WinampHandle, WM_USER, -666, 122)
    SendMessage WinampHandle, WM_USER, 0, 122
  Else
    SendMessage WinampHandle, WM_USER, Mute, 122
    Mute = 0
  End If
End Sub

Private Sub Form_Load()
  modMain.WinampHandle = GetHWnd
  If modMain.WinampHandle = 0 Then
    MsgBox "WinAmp muss zuerst gestartet werden, " & _
           "um ihn auch fernsteuern zu können."
    Unload Me
    End
  End If
  Me.Caption = "WinAmp " & GetVersion & " fernsteuern"
  SetWindowPos frmPlugin.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
  slider_track.Max = SendMessage(WinampHandle, WM_USER, 1,_
        IPC_GETOUTPUTTIME)
  Slider_volume.Value = SendMessage(WinampHandle, WM_USER, -666, 122)
End Sub

Private Sub cmdBack_Click()
  SendCommand WA_FRW
End Sub

Private Sub cmdNext_Click()
  SendCommand WA_FFW
End Sub

Private Sub cmdPlay_Click()
  If cmdPlay.Caption = "&Pause" Then
     cmdPlay.Caption = "&Play"
     SendCommand WA_PAUSE
  Else
     cmdPlay.Caption = "&Pause"
     SendCommand WA_PLAY
  End If
End Sub

Private Sub cmdStop_Click()
  SendCommand WA_FADESTOP    
  If cmdPlay.Caption = "&Pause" Then cmdPlay.Caption = "&Play"
End Sub

Private Sub cmdInfo_Click()
  SendCommand WA_SHOWFILEINFO
End Sub

Private Sub cmdBeenden_Click()
  mnuFileExit_Click
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
        X As Single, Y As Single)
  If Button = 2 Then SendCommand WA_POPUPMENU
End Sub

Private Sub mnuBrowse_Click()
  SendCommand WA_MINIBROWSE
End Sub

Private Sub mnuFileOpen_Click()
  SendCommand WA_FILE_PLAY
End Sub

Private Sub mnuFileExit_Click()
  SendCommand WA_QUIT
  Unload Me
End Sub

Private Sub mnuHelpInfo_Click()
  SendCommand WA_HELP_ABOUT
End Sub

Private Sub mnuJump_Click()
  SendCommand WA_JMP_TO_TIME
End Sub

Private Sub mnuJumpFile_Click()
  SendCommand WA_JMPFILE
End Sub

Private Sub mnuPlayList_Click()
  SendCommand WA_OPTIONS_PLEDIT
End Sub

Private Sub mnuPrev_Click()
  SendCommand WA_TOGGLEPREF
End Sub

Private Sub mnuShow_Click()
  SendCommand WA_TOGGLEMW
End Sub

Private Sub mnuVisual_Click()
  SendCommand WA_OPENVIPLUG
End Sub

Private Sub slider_track_Scroll()
  SendMessage WinampHandle, WM_USER, _
      slider_track.Value * 1000, IPC_JUMPTOTIME
End Sub

Private Sub Slider_volume_Scroll()
  SendMessage WinampHandle, WM_USER, Slider_volume.Value, 122
End Sub

Private Sub Timer1_Timer()
  Dim ElapsedTime As Long, lngTime As Long, Channel As Long
  Dim Success As Long

  SendMessageTimeout WinampHandle, WM_USER, 0, IPC_GETOUTPUTTIME, _
      SMTO_BLOCK, 1000, ElapsedTime

  lblZeit.Caption = ElapsedTime / 1000 \ 60 & ":" & _
     Format$(ElapsedTime / 1000 Mod 60, "00")
  slider_track.Value = ElapsedTime / 1000
  Slider_volume.Value = SendMessage(WinampHandle, _
     WM_USER, -666, 122)

  lngTime = SendMessage(WinampHandle, WM_USER, 1, 105)
  lblLaenge.Caption = lngTime \ 60 & ":" & _
     Format$(lngTime Mod 60, "00")

  lblTitel.Caption = GetTitle

  lblKhz.Caption = Str$(SendMessage(WinampHandle, _
     WM_USER, 0, IPC_GETINFO))
  lblSample.Caption = Str$(SendMessage(WinampHandle, _
     WM_USER, 1, IPC_GETINFO))
  Channel = SendMessage(WinampHandle, WM_USER, 2, IPC_GETINFO)
  If Channel <> 2 Then Frame1.Caption = " Mono " Else _
     Frame1.Caption = " Stereo "
End Sub