frmvbamp.frm

一个类似于WinAmp的Mp3播放器,功能不错,有换肤等功能,是一个不错的vb播放器.

'Stop playback
Sub StopIt()
    CleanUP
    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
        MediaControl.Run
    Else
        MediaControl.Pause
    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()
Dim p As Double
    p = Elapsed - 10: Call PlayFrom(p)
End Sub

'Skip forward 10 seconds
Sub Forward()
Dim p As Double
    p = Elapsed + 10: 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()
Dim F As String, FileType As String, M As String, Cr As String, M2 As String
Dim CPos As Long, Min As Integer, Sec As Integer, X As String
Dim PicDelay As Long, E As Currency
    '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: Call StopIt: Exit Sub
    
    Timer1.Enabled = False
    CleanUP
        
    'Clear file details
    Lbl(10).Caption = "": Lbl(11).Caption = "": Lbl(12).Caption = ""
    RptA = 0: RptB = 0
    
    'Check for file
    SongPath = PlPath.List(TNum - 1)
    If Left$(UCase$(SongPath), 5) = "HTTP:" Then
        InternetFile = True
    Else
        InternetFile = False
        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
        End If
    End If
        
    FileType = UCase(GetExtension(SongPath))
    PicDelay = 0
    
    Dev = "DX" 'default playback method
    Select Case FileType
        Case "MP2", "MP3", "MPA"
            Call GetMP3Info
            X = GetPath(SongPath)
            If OptUseTagCover = 1 Then Call LoadTagCover(X, InfoTag.Artist, InfoTag.Album)
        Case "BMP", "GIF", "JPG": GoSub DoBitmap
        Case "TXT", "DOC", "BAT", "COM", "EXE", "LNK": Dev = "Delay": Exit Sub
    End Select
    
    'Reset elapsed slider
    Call SetSlider(1, 0): If Sli(1).W + Sli(1).H > 0 Then iSlider(1).Visible = True
        
    'Set Titles
    If Trim$(InfoTag.Title) <> "" Then PlNames.List(TNum - 1) = InfoTag.Title 'use title from MP3 tag
    SongName = PlNames.List(TNum - 1)
    Call SetDD(6, SongName)
    Lbl(2).Caption = SongName
    Lbl(4).Caption = Str(TNum)
    Call SetDD(2, TNum)
    
    Select Case Dev
      Case "Delay"
      Case Else
        'Play all types of files here
        Set MediaControl = New FilgraphManager
        If MediaControl Is Nothing Then MsgBox "Cannot create the IMediaControl object": Exit Sub
        Set MediaPosition = MediaControl
        Set BasicAudio = MediaControl
        MediaControl.RenderFile (SongPath)
        If InternetFile = True Then
            SongLen = 0
        Else
            MediaPosition.CurrentPosition = 0
            MediaPosition.Rate = 0.5 + Sli(5).V
            SongLen = MediaPosition.Duration
        End If
        MediaControl.Run '<<<< start playing NOW!
    End Select
    
    'Set the display indicators
    Paused = False: Playing = True
    Call ShowLights
    
    'Highlight the track in the playlist
    PlNames.ListIndex = TNum - 1
    
    'Calculate the total track length
    CPos = SongLen
    Min = Int(CPos / 60): Sec = Int(CPos - Min * 60)
    X = Format(Min, "") + ":" + Format(Sec, "00")
    Lbl(13).Caption = X 'Call SetDD(1, pos)
    Lbl(26).Caption = "Media"
    
    Timer1.Enabled = True
    Exit Sub

'Handle bitmap files
DoBitmap:
    Dev = "Delay": SongLen = 5: Elapsed = 0
    Call LoadCover(SongPath)
    PlNames.ListIndex = TNum - 1
    Timer1.Enabled = True
    Return
  
End Sub

'Sets the Playback Rate (Only for DX driver)
Sub SetRate(n)
    Dim PBRate As Single
    PBRate = 0.5 + n 'Range=.5 to 1.5 times normal rate
    If Playing = True Then MediaPosition.Rate = PBRate
    Lbl(24).Caption = Format$(PBRate * 100, "###") + "%"
End Sub

'Play track from specified position
Sub PlayFrom(ByVal SPos As Long)
If MediaControl Is Nothing Then Exit Sub
    If SPos < 0 Then SPos = 0
    If SPos > SongLen Then SPos = SongLen - 1
    MediaPosition.CurrentPosition = SPos
End Sub

'Toggle Album Cover Display
Private Sub ToggleCover()
    If frmAlbum.Visible = True Then
        frmAlbum.Visible = False
    Else
        frmAlbum.Visible = True
    End If
End Sub

'Toggle Intro Mode
Private Sub ToggleIntro()
    Intro = Not Intro: Call ShowLights
End Sub

'Toggle Single Track Play Mode
Private Sub ToggleSTP()
    STP = Not STP: Call ShowLights
End Sub

'Toggle Random Mode (may repeat tracks)
Private Sub ToggleRand()
    Random = Not Random
    Shuffle = Not Shuffle: Call ShowLights
End Sub

'Toggle Shuffle Mode (random play with no repeats to end of playlist)
'(not implemented yet - use random mode)
Private Sub ToggleShuf()
    Random = Not Random
    Shuffle = Not Shuffle: Call ShowLights
End Sub

'Toggle Repeat Mode
Private Sub ToggleRpt()
    Repeat = Not Repeat: Call ShowLights
End Sub

'Set AB-Repeat A-point (or both if B button not visible!)
Private Sub SetA()
    If Btn(31).Visible = False Then
        'No B button so combine functions here!
        If RptA > 0 Then
            If RptB = 0 Then Call SetB Else RptA = 0: RptB = 0
        Else
            GoSub SetRA
        End If
    Else
        'RptB exists so only perform RptA.
        GoSub SetRA
    End If
    Call ShowLights
    Exit Sub
    
SetRA: RptA = Elapsed: RptB = 0: Return

End Sub

'Set AB-Repeat B-point
Private Sub SetB()
    RptB = Elapsed: Call ShowLights
End Sub

'Increase volume by 5增音
Private Sub VolUp()
    Call VolChange(5)
End Sub

'Decrease volume by 5减音
Private Sub VolDn()
    Call VolChange(-5)
End Sub

'Mute the volume静音
Private Sub VolMute()
    Static LastVolLevel As Integer
    Dim Pct As Single
    If Mute = True Then
        Pct = LastVolLevel: Mute = False
        Call VolChange(Pct)
    Else
        LastVolLevel = Int(GetVol() * 100)
        Call VolChange(-100): Mute = True
    End If
    Call ShowLights
End Sub

'Change volume level改变音值
Private Sub VolChange(ByVal Chg As Integer)
    Dim Pct As Single
    If Mute = True Then Call VolMute
    Pct = GetVol() + Chg / 100
    If Pct < 0 Then Pct = 0
    If Pct > 1 Then Pct = 1
    Call SetSlider(2, Pct) 'move slider
    Call DoSlider(2, Pct) 'set volume and label改变音值跟文本框
End Sub

'Add Media, Playlist file, or directory to the playlist
Private Sub PlAddFile()
Dim Ext As String
   If AddName <> "" Then
        Ext = UCase(GetExtension(AddPath))
        If Ext = "M3U" Or Ext = "PLS" Then
            'Add playlist
            Call PlRead(AddPath)
        Else
            If (GetAttr(AddPath) And vbDirectory) = vbDirectory Then  ' it represents a directory.
                'Add directory
                Call AddDir(AddPath, Me, PlNames, PlPath, Pref.ValExt.Text)
            Else
                'Add media file
                If IsPic(AddPath) Then AddTitle = AddTitle + " (picture)"
                PlNames.AddItem AddTitle
                PlPath.AddItem AddPath
                If TNum = 0 Then TNum = 1
            End If
        End If
    End If
    Call SetPLTot
End Sub

'Delete Playlist Button
Private Sub DelTrack()
    Call PlDelete(PlNames.ListIndex)
End Sub

'Delete Playlist entry
Private Sub PlDelete(ByVal n)
    If n >= 0 And n < PlNames.ListCount Then
        PlNames.RemoveItem (n)
        PlPath.RemoveItem (n)
        If n > PlNames.ListCount - 1 Then n = PlNames.ListCount - 1
        PlNames.ListIndex = n
    End If
    Call SetPLTot

End Sub

'Clear Playlist
Sub PlClear()
    PlNames.Clear: PlPath.Clear: TNum = 1
    iCover.Picture = Nothing
    frmAlbum.Cover.Picture = Nothing
    Lbl(14).Caption = "untitled"
    Call SetPLTot
    PLCover = ""
End Sub

'Move Playlist entry up or down
Sub PlMoveEntry(D As Integer)
Dim n As Integer, T1 As String, T2 As String
    n = PlNames.ListIndex
    If (n + D) >= 0 And (n + D) < PlNames.ListCount Then
        T1 = PlNames.List(n): T2 = PlPath.List(n)
        PlNames.List(n) = PlNames.List(n + D)
        PlPath.List(n) = PlPath.List(n + D)
        PlNames.List(n + D) = T1
        PlPath.List(n + D) = T2
        PlNames.ListIndex = n + D
    End If
End Sub

'Set Playlist Total Entries label
Private Sub SetPLTot()
    Lbl(16).Caption = Str(PlNames.ListCount)
End Sub

'Display Load dialog
Private Sub GetOneFile()
    Static LastFilter
    If LastFilter = 0 Then LastFilter = 1
    AddName = ""
    
    On Error GoTo ErrHandler
    
    CommonDialog1.CancelError = True
    CommonDialog1.InitDir = OptDefPath
    CommonDialog1.DialogTitle = "Open Media file"
    CommonDialog1.Flags = cdlOFNHideReadOnly
    CommonDialog1.Filter = "MPEG Audio Files|*.MP?|ActiveMovie Files|*.MP?;*.MPEG;*.DAT;*.WAV;*.AU;*.MID;*.RMI;*.AIF?;*.MOV;*.QT;*.AVI;*.M1V;*.RA;*.RAM;*.RM;*.RMM|Music Modules|*.MOD;*.MTM;*FAR;*.669;*.OKT;*.STM;*.S3M;*.NST;*.WOW;*.XM|Bitmaps|*.BMP;*.GIF;*.JPG|Playlists|*.M3U;*.PLS|All Files|*.*"
    CommonDialog1.FilterIndex = LastFilter
    CommonDialog1.Filename = ""
    
    CommonDialog1.ShowOpen
    DoEvents
    
    LastFilter = CommonDialog1.FilterIndex
    
    AddName = CommonDialog1.FileTitle
    
    AddTitle = MakeTitle(AddName)
    AddPath = CommonDialog1.Filename
    OptDefPath = Left(AddPath, Len(AddPath) - Len(AddName))
    SaveSetting Prg, Sect, "Path", OptDefPath
        
ErrHandler:
    Exit Sub
End Sub

'Playlist - Double-click
Private Sub PlNames_DblClick()
    TNum = PlNames.ListIndex + 1
    Call PlayIt
End Sub

'Playlist - Keypress Handler
Private Sub PlNames_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 46 Then Call PlDelete(PlNames.ListIndex)
End Sub

' Timer routine to update position slider and check for end
' of song, do repeat etc
Private Sub Timer1_Timer()
Static LastPos As Long, LastTime As String
Dim pos As Single, PStr As String, Min As Integer, Sec As Integer
Dim X As String
        
    DoEvents
  
    If Playing = False Or SongLen = 0 Then Exit Sub
  
    If Dev = "Delay" Then
        If Not Paused Then Elapsed = Elapsed + Timer1.Interval
    Else
        Elapsed = MediaPosition.CurrentPosition
    End If
    
    Remain = SongLen - Elapsed
    If TimeFlag Then TimeDisp = Remain Else TimeDisp = Elapsed
    
    pos = TimeDisp
    Min = TimeDisp \ 60: Sec = Int(TimeDisp - Min * 60)
    X = Format(Min, "") + ":" + Format(Sec, "00")
    If TimeFlag Then X = "-" + X
    
    If X <> LastTime Then
        Lbl(1).Caption = X: Call SetDD(1, pos)
        LastTime = X
        'Debug.Print X
    End If