frmvbamp.frm

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

        Case "MOD", "MTM", "FAR", "669", "OKT", "STM", "S3M", "NST", "WOW", "XM": Dev$ = "M4W_MCI"
        Case "FLI", "FLC": Dev$ = "Animation"
        Case "AWA", "AWM": Dev$ = "Animation1"
        Case "MMM": Dev$ = "MMMovie"
        Case "CDA": Dev$ = "cdaudio": CDTrack = Val(Right$(SongPath, 6)) '**** TEST
        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
    Lbl(2).Caption = PlNames.List(TNum - 1)
    Lbl(4).Caption = Str$(TNum)
    Call SetDD(2, TNum)
            
    'Play the file
    MMControl(PlayUnit).DeviceType = Dev$ 'select MCI driver
    MMControl(PlayUnit).TimeFormat = 0
       
    Select Case Dev$
      Case "cdaudio" 'this is test code! needs work...
        MMControl(PlayUnit).Filename = ""
        MMControl(PlayUnit).Command = "open"
        If MMControl(PlayUnit).Error > 0 Then GoSub MCIError: Exit Sub
        MMControl(PlayUnit).Track = CDTrack
        PFrom! = MMControl(PlayUnit).TrackPosition
        SongLen = MMControl(PlayUnit).TrackLength
        MMControl(PlayUnit).From = PFrom!
        MMControl(PlayUnit).To = PFrom! + SongLen - 1
        MMControl(PlayUnit).Command = "play"
      Case "Delay"
      Case Else
        MMControl(PlayUnit).Filename = SongPath
        MMControl(PlayUnit).Wait = True
        MMControl(PlayUnit).Command = "open"
        If MMControl(PlayUnit).Error > 0 Then GoSub MCIError: Exit Sub
        MMControl(PlayUnit).From = 0
        SongLen = MMControl(PlayUnit).TrackLength
        MMControl(PlayUnit).Command = "play"
    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
    pos = SongLen / 1000
    Min = Int(pos / 60): Sec = Int(pos - Min * 60)
    X$ = Format$(Min, "") + ":" + Format$(Sec, "00")
    Lbl(13).Caption = X$ 'Call SetDD(1, pos)
    
    If Dev$ = "M4W_MCI" Then GoSub ClearM4WBeta
    
    Timer1.Enabled = True
    Exit Sub

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

'This is a sneaky routine that automatically closes the Mod4Win BETA
'about box that pop up when each track is started... :-)
ClearM4WBeta:
    On Error GoTo CM4WErr
    While MMControl(PlayUnit).Position < 1: Wend
    AppActivate "MOD": DoEvents
    SendKeys " "
    Return
CM4WErr: Resume Next

'Display MCI error message
MCIError:
    E = MMControl(PlayUnit).Error
    M$ = MMControl(PlayUnit).ErrorMessage: M2$ = ""
        
    Select Case E
      Case 263: M2$ = Dev$ & " MCI driver is NOT installed." & Chr$(13) & "See VB-Amp documentation!"
      Case Else: M2$ = "Unhandled VB-Amp error"
    End Select
    
    MsgBox M$ & Chr$(13) & Chr$(13) & M2$
    Dev$ = ""
    Return
    
End Sub

'Play track from specified position
Sub PlayFrom(ByVal SPos As Long)
    If SPos < 0 Then SPos = 0
    If SPos > SongLen Then SPos = SongLen - 1000
    MMControl(PlayUnit).Command = "stop"
    MMControl(PlayUnit).From = SPos
    MMControl(PlayUnit).Command = "Play"
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 Shuffle Mode
Private Sub ToggleShuf()
    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 RpA.
        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
    
    If Mute = True Then
        Pct = LastVolLevel: Mute = False
        Call VolChange(Pct)
    Else
        LastVolLevel = Int(GetVol() * 100)
        Call VolChange(-100): Mute = True
    End If
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 or Playlist file or directory to the playlist
Private Sub PlAddFile()
   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
End Sub

'Move Playlist entry up or down
Sub PlMoveEntry(D)
    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
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
    
    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, LastTime$
    Dim pos As Single
        
    DoEvents
  
    If Playing = False Or SongLen = 0 Then Exit Sub
  
    If Dev$ = "Delay" Then
        If Not Paused Then Elapsed = Elapsed + Timer1.Interval
    Else
        Elapsed = MMControl(PlayUnit).Position
    End If
    
    Remain = SongLen - Elapsed
    If TimeFlag Then TimeDisp = Remain Else TimeDisp = Elapsed
    'Frame = Elapsed / 25
    pos = TimeDisp \ 1000
    Min = pos \ 60: Sec = Int(pos - 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$
    End If
    'sBlip.Left = 12 + (Frame Mod 78)
    
    'only update if user not adjusting position!
    If SlideFlag <> 1 And iSlider(1).Visible = True Then
        pos = Elapsed / SongLen: Call SetSlider(1, pos)
    End If
       
    If Intro = True Then
        'Check if 10 seconds elapsed
        If Elapsed > 10000 Then GoSub GoNext
    End If
    
    If RptB > 0 Then
        'Check if past B position
        If Elapsed >= RptB Then Call PlayFrom(RptA)
    End If
'Check if song is finished or past overlap
    If Elapsed >= SongLen - OptPBOverlap Then GoSub GoNext
    Exit Sub

' If Repeat=True, Play same track
' If STP=True, Go to next track but don't play
GoNext:
    If OptPBOverlap > 0 Then PlayUnit = 1 - PlayUnit 'switch playback control
    If Repeat = False Then
        If Shuffle = True Then
            TNum = Rnd(Timer) * PlNames.ListCount + 1
        Else
            TNum = TNum + 1
        End If
    End If
    Call PlayIt
    If STP = True Then Call StopIt
    Return
    
End Sub

'Timer 2 used for Auto On/Off events and Realtime Clock display/date
'and volume level checking
Private Sub Timer2_Timer()
    Dim volume As Long, Pct As Single
    
    'Check Auto On/Off and Snooze
    If Right$(Time$, 2) = "00" Then
        GoSub CheckZero
    Else
        If OptAuto = 1 Then
            If OptSnooze = 1 Then
                If SnoozeTm < 0 Then GoSub SetSnoozeLbl
            Else
                Lbl(5).Caption = ""
            End If
        Else
            Lbl(5).Caption = ""
        End If
    End If
    
    'Check Volume
    Pct = GetVol()
    Call SetSlider(2, Pct) 'move slider

Exit Sub

CheckZero:
    FJ$ = "hh:mm   "
    If OptTimeFmt = 0 Then FJ$ = "hh:mm AMPM"
            
    Lbl(3).Caption = Format$(Time, FJ$)
    Call SetDD(3, 0)
    If Time$ = "00:00:00" Then Call MakeDayStr
    If OptAuto = 1 Then
        If OptSnooze = 1 Then GoSub CheckSnooze
        GoSub CheckOO
    End If
    Return
    
SetSnoozeLbl:
    SnoozeTm = Abs(SnoozeTm)
    If OptSnooze = 1 Then
        If OptSnoozeMd = 0 Then
            Lbl(5).Caption = Format$(SnoozeTm, "00")
        Else
            Lbl(5).Caption = OptSnoozeAt
        End If
    End If
    Return

CheckSnooze:
    If OptSnoozeMd = 0 Then
        SnoozeTm = SnoozeTm - 1
        Lbl(5).Caption = Format$(SnoozeTm, "00")