frmvbamp.frm

一个无需MP3控件的MP3播放器源码

    End If
    Timer1.Enabled = True
    Exit Sub
    
LoadLast:
    'Load playlist and set last track
    On Error Resume Next
        
    F$ = App.Path + "\playlist.m3u"
    If Exists(F$) = True Then
      PlRead (F$)
      TNum = Val(GetSetting$(Prg, Sect, "LastTrack", "0"))
      If OptAutoPlay = 1 Then Call PlayIt
    End If
    LastCover$ = GetSetting$(Prg, Sect, "LastCover", "")
    If LastCover$ <> "" Then LoadCover (LastCover$)
    Return

    
PLErr:
End Sub

'Clean up and save settings before exiting program
Private Sub Form_Unload(Cancel As Integer)

    MMControl(PlayUnit).Command = "close"
    
    'save settings
    SaveSetting Prg, Sect, "Skin", OptSkinName
    SaveSetting Prg, Sect, "SkinPath", OptSkinPath
    
    SaveSetting Prg, Sect, "WinOnTop", Str$(OptAlwaysOnTop)
    SaveSetting Prg, Sect, "WinSnap", Str$(OptSnap)
    SaveSetting Prg, Sect, "WinSavePos", Str$(OptSavePos)
    SaveSetting Prg, Sect, "Auto", Str$(OptAuto)
    SaveSetting Prg, Sect, "Snooze", Str$(OptSnooze)
    SaveSetting Prg, Sect, "SnoozeMode", Str$(OptSnoozeMd)
    SaveSetting Prg, Sect, "SnoozeTime", OptSnoozeAt
    SaveSetting Prg, Sect, "SnoozeHide", Str$(OptMinOnSnz)
    SaveSetting Prg, Sect, "ExitMode", Str$(OptExitMd)
    SaveSetting Prg, Sect, "StartMd", Str$(OptStartMd)
    SaveSetting Prg, Sect, "StartMin", Str$(OptStartMin)
    SaveSetting Prg, Sect, "StartMute", Str$(OptStartMute)
    SaveSetting Prg, Sect, "StartPlaylist", OptStartPlaylist
    SaveSetting Prg, Sect, "TimeFmt", Str$(OptTimeFmt)
    SaveSetting Prg, Sect, "VisPLPath", OptVisPLPath
    SaveSetting Prg, Sect, "ClearPlFirst", OptClrPl
    SaveSetting Prg, Sect, "AutoPlay", OptAutoPlay
    SaveSetting Prg, Sect, "ValidExt", OptValExt
    SaveSetting Prg, Sect, "PBOverlap", OptPBOverlap
    
    If OptSavePos = 1 Then
        SaveSetting Prg, Sect, "X", Me.Left
        SaveSetting Prg, Sect, "Y", Me.Top
    End If
    
    Call SaveAutoList
    
    'Save playlist and current track
    SaveSetting Prg, Sect, "LastCover", LastCover$
    SaveSetting Prg, Sect, "LastTrack", Str$(TNum)
    WritePL (App.Path + "\playlist.m3u")
    Unload frmIcon
    End
    
End Sub

'Called when the form is clicked to activate it
Private Sub Form_Activate()
    TwipX = Screen.TwipsPerPixelX
    TwipY = Screen.TwipsPerPixelY
    
    Call AlwaysOnTop(Me, OptAlwaysOnTop)
End Sub

'Called when other windows move to uncover part of our window
Private Sub Form_Paint()
    Call SetDD(1, Elapsed \ 1000)
    Call SetDD(2, TNum)
    Call SetDD(3, 0)
    Call SetDD(4, Val(Lbl(10).Caption))
    Call SetDD(5, Val(Lbl(11).Caption))
    Lbl(3).Caption = Left$(Time$, 5)
End Sub

'Main function dispatcher. Index corresponds to button number
Private Sub DoIt(Index As Integer)
    
    Select Case Index
        Case 1: Unload Me 'Power button
        Case 2: Me.Visible = False 'Minimize (hide) window
        Case 3: Call ToggleLarge 'Toggle Large Mode (window size 2)
        Case 4: Call ToggleSmall 'Toggle Small Mode (window size 3)
        Case 5: Call ShowPrefs 'About / Preferences
        Case 6: Call SelectSkin 'Select Skin
        Case 7: Call VolDn
        Case 8: Call VolUp
        Case 9: Call VolMute
        Case 10: Call StopIt 'Stop
        Case 11: Call PauseIt 'Pause
        Case 12: Call PlayIt 'Play
        Case 13: Call Eject 'Eject
        Case 14: Call PrevTrack 'Previous Track
        Case 15: Call NextTrack 'Next Track
        Case 16: Call ShowInfo 'Info
        Case 17: Call DelTrack 'Delete Track
        Case 18: Call PlMoveEntry(1) 'Move Track Down
        Case 19: Call PlMoveEntry(-1) 'Move Track Up
        Case 20: Call PlClear 'Clear Playlist
        Case 21: Call PlLoad 'Load Playlist
        Case 22: Call PlSave 'Save Platlist
        Case 23: Call GetOneFile: Call PlAddFile 'Add File
        Case 24: Call AddFromDir 'Add Directory
        Case 25: Call ToggleIntro 'Intro
        Case 26: Call ToggleSTP 'Toggle STP mode
        Case 27: Call ToggleRpt 'Toggle repeat mode
        Case 28: Call ToggleShuf 'Toggle shuffle mode
        Case 29: Call ShowMixer 'run std windows mixer
        Case 30: Call SetA 'Set AB repeat Start point
        Case 31: Call SetB 'Set AB repeat End point
        Case 32: Call Reverse 'reverse playback position 10 seconds
        Case 33: Call Forward 'advance playback position 10 seconds
        Case 34: Call ToggleCover 'Toggle cover bitmap window
        Case 35: Call ShowVisSelect 'Show Visual Playlist Selector window
        Case 36: Call PlayPause 'Toggle play/pause
        Case 49: Call LoadSkin(ByVal SkinLink1) 'load linked skin#1
        Case 50: Call LoadSkin(ByVal SkinLink2) 'load linked skin#2
    End Select
    
End Sub

'When Cover bitmap is clicked
Private Sub iCover_DblClick()
    Call SelectCover
End Sub

'Add files to playlist when files dropped to playlist object
Private Sub PlNames_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Data.GetFormat(vbCFFiles) Then
     Dim vFn As Variant
     For Each vFn In Data.Files
       AddName = vFn: AddPath = AddName: AddTitle = MakeTitle$(AddName)
       Call PlAddFile
     Next vFn
  End If
End Sub

'Provide drag and drop feedback to source
Private Sub PlNames_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
  '0=do not allow drop, 1=inform source that data will be copied
  If Data.GetFormat(vbCFFiles) Then Effect = 1 Else Effect = 0
End Sub

'Add files to playlist when files dropped to form
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Data.GetFormat(vbCFFiles) Then
     Dim vFn As Variant
     For Each vFn In Data.Files
       AddName = vFn: AddPath = AddName: AddTitle = MakeTitle$(AddName)
       Call PlAddFile
     Next vFn
  End If
End Sub

'Provide drag and drop feedback to source
Private Sub Form_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
  If Data.GetFormat(vbCFFiles) Then Effect = 1 Else Effect = 0
End Sub

'Called from tray icon
Public Sub Quit()
    Unload Me
End Sub

'Display alternate-bitmap/outline when mouse moves over button
Private Sub Btn_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Index <> LastIndex) Then
        If CoolFlag = 1 Then
            Btn(LastIndex).BorderStyle = 0
            Btn(Index).BorderStyle = 1
        ElseIf CoolFlag = 2 Then
            Call ButtonDown(Index)
        End If
        LastIndex = Index
    End If
    InActCnt = 1
End Sub

'Button pressed
Private Sub Btn_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call ButtonDown(Index)
End Sub

'Button released
Private Sub Btn_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call ButtonUp(Index)
End Sub

'Button released (event goes to Temp Button bitmap)
Private Sub TmpBtn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call ButtonUp(LastIndex)
End Sub

'Remove the tmpbtn to reveal original "up" image
Private Sub ButtonUp(Index)
    TmpBtn.Visible = False: DoEvents
    Btn(Index).BorderStyle = 0
    Call DoIt(Index)
End Sub

'Display alternate button image by copying region to tmpbtn then
'moving to proper location and making it visible
Sub ButtonDown(Index)
    X = Btn(Index).Left
    Y = Btn(Index).Top
    W = Btn(Index).Width
    H = Btn(Index).Height
    X2 = cx(Index): Y2 = cy(Index)
    
    TmpBtn.Visible = False
    TmpBtn.Move X, Y, W, H  'Place temp button image over area
    TmpBtn.PaintPicture ResBmp.Picture, 0, 0, W, H, X2, Y2, W, H
    TmpBtn.ToolTipText = Btn(Index).ToolTipText
    TmpBtn.Visible = True
    
End Sub

'The form is being clicked in area where no buttons/labels etc are
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim IX2  As Integer, IY2 As Integer
    Dim hMenu As Long, hSubMenu As Long, R As Integer
    Dim menRect As RECT
    
    If Button And 1 Then
        ' Setup form for Dragging
        If DragFlag = False Then
            IX = X * TwipX: IY = Y * TwipY
            FX = Me.Left: FY = Me.Top
            DragFlag = True
        End If
    ElseIf Button And 2 Then
        ' Display menu from frmIcon form
        menRect.Left = 0: menRect.Top = 0
        menRect.Right = Screen.Width
        menRect.Bottom = Screen.Height
        IX2 = Left / TwipX + X
        IY2 = Top / TwipY + Y
        hMenu = GetMenu(frmIcon.hWnd)
        hSubMenu = GetSubMenu(hMenu, 0) 'choose submenu that coresponds to image icon
        R = TrackPopupMenu(hSubMenu, 2, IX2, IY2, 0, frmIcon.hWnd, menRect)
    End If
End Sub

'Move the form to follow the mouse
Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If DragFlag = True Then
        Me.Move FX + ((X * TwipX) - IX), FY + ((Y * TwipY) - IY)
        FX = Me.Left: FY = Me.Top
    Else
        If LastIndex <> 0 Then
            Btn(LastIndex).BorderStyle = 0
            LastIndex = 0
            TmpBtn.Visible = False
        End If
    End If
End Sub

'The form is finished moving. Snap to viewport if enabled
Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DragFlag = False
    If OptSnap Then Call Snap2ViewPoint(Me)
End Sub

'Main keypress handler
Private Sub Form_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 96  'debug- make button and label background non-transparent
            For J = 1 To 50: Btn(J).BackStyle = 1: Next
            For J = 1 To 20: Lbl(J).BackStyle = 1: Next: KeyAscii = 0
        Case 126 'debug- set button border
            For J = 1 To 50: Btn(J).BorderStyle = 1: Next: KeyAscii = 0
        Case 27  'debug- make buton and label transparent again
            For J = 1 To 50: Btn(J).BackStyle = 0: Btn(J).BorderStyle = 0: Next
            For J = 1 To 20: Lbl(J).BackStyle = 0: Next: KeyAscii = 0
        Case Else
            If InFlag = False Then
                Ky$ = UCase$(Chr$(KeyAscii))
                For J = 1 To 40
                    If Ky$ = Kbd(J) Then Call DoIt(J): Exit For
                Next
                KeyAscii = 0
            End If
    End Select
End Sub

'Handle clicking labels
Private Sub Lbl_Click(Index As Integer)
    Select Case Index
        Case 1: TimeFlag = Not TimeFlag 'Elapsed/remaining Time
        Case 2: Call ShowInfo 'Track title
    End Select
End Sub

'Toggle Large View Mode
Private Sub ToggleLarge()
    HFlag = 1 - HFlag
    If Small = 0 Then Me.Width = FSize(HFlag).X: Me.Height = FSize(HFlag).Y
End Sub

'Toggle Small View Mode
Private Sub ToggleSmall()
    Small = 1 - Small
    n = HFlag: If Small = 1 Then n = 2
    Me.Width = FSize(n).X
    Me.Height = FSize(n).Y
End Sub

'Eject Playlist, Get new file/playlist then play
Private Sub Eject()
    Call GetOneFile
    If AddName <> "" Then
        Call PlClear
        Call PlAddFile
        TNum = 1
        Call PlayIt
    End If
    Exit Sub
End Sub

'Stop playback
Sub StopIt()
    MMControl(PlayUnit).From = 0
    MMControl(PlayUnit).Command = "seek"
    MMControl(PlayUnit).Command = "stop"
    iSlider(1).Visible = False
    Lbl(1).Caption = ":"
    Paused = False: Playing = False
    Call ShowLights
End Sub

'Toggle Playback (Pause/resume)
Sub PauseIt()
    If Ind(2).Visible = True Then Exit Sub
  
    If Paused = True Then
        MMControl(PlayUnit).Command = "play"
    Else
        MMControl(PlayUnit).Command = "stop"
    End If
    Paused = Not Paused
    Call ShowLights
End Sub
Sub PlayPause()
    If Playing = False Then Call PlayIt Else Call PauseIt
End Sub
'Skip backwards 10 seconds
Sub Reverse()
    p! = Elapsed - 10000: Call PlayFrom(p!)
End Sub

'Skip forward 10 seconds
Sub Forward()
    p! = Elapsed + 10000: Call PlayFrom(p!)
End Sub

'Play Next Track
Sub NextTrack()
    TNum = TNum + 1: Call PlayIt
End Sub

'Play the Previous track
Sub PrevTrack()
    TNum = TNum - 1: Call PlayIt
End Sub

' This starts to play the selected track (TNUM)
Sub PlayIt()
        
    'Check if track number is valid
    If PlNames.ListCount = 0 Then Exit Sub
    If TNum < 1 Then TNum = PlNames.ListCount
    If TNum > PlNames.ListCount Then TNum = 1
    
    Timer1.Enabled = False
    If MMControl(1 - PlayUnit).Mode = mciModePlay Then
        If MMControl(1 - PlayUnit).Position < OptPBOverlap Then
            MMControl(1 - PlayUnit).Wait = True
            MMControl(1 - PlayUnit) = "stop"
            MsgBox "!@#!@!#"
        End If
    End If
    MMControl(PlayUnit).Command = "close"
    
    
    SongPath = PlPath.List(TNum - 1)
    
    'Clear file details
    Lbl(10).Caption = "": Lbl(11).Caption = "": Lbl(12).Caption = ""
    
    'Reset AB repeat points
    RptA = 0: RptB = 0
    
    'Check for file
    If Exists(SongPath) = False Then
        F$ = "[FILE NOT FOUND]" 'TODO: Auto delete here?
        X$ = PlNames.List(TNum - 1)
        If InStr(X$, F$) = 0 Then PlNames.List(TNum - 1) = X$ + " " + F$
        PlPath.List(TNum - 1) = ""
        Dev$ = "": Exit Sub
    Else
      Info = "Filename= " & SongPath 'Default info
    End If
    
    X$ = UCase$(Right$(SongPath, 5)): p = InStr(X$, ".")
    FileType$ = Mid$(X$, p + 1): PicDelay = 0
    
    Dev$ = "ActiveMovie" 'default MCI device
    Select Case FileType$
        Case "MP2", "MP3", "MPA": Call GetMP3Info