frmvbamp.frm

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

    OptValExt = GetSetting(Prg, Sect, "ValidExt", "mp2 mp3 mpa wav mid rmi")
    OptPBOverlap = Val(GetSetting(Prg, Sect, "PBOverlap", OptPBOverlap))
    OptScrollName = Val(GetSetting(Prg, Sect, "ScrollName", 0))
    OptUseTagCover = Val(GetSetting(Prg, Sect, "UseTagCover", 0))
    OptFriendly = Val(GetSetting(Prg, Sect, "FriendlyNames", 1))
    
    'Set Initial Window Position
    X = Val(GetSetting(Prg, Sect, "X", Me.Left))
    Y = Val(GetSetting(Prg, Sect, "Y", Me.Top))
    Me.Move X, Y
    
    'Initialize Playback settings
    PlayUnit = 0
    TNum = 1
    ScrollStart = 1
   
    Stereo = False
    Playing = False
    Paused = False
    Intro = False
    STP = False
    Repeat = False
      
    'Get the current skin name
    If OptSkinName <> "" Then If Exists(OptSkinName) = False Then OptSkinName = "": MsgBox "Previously selected skin not found (" & OptSkinName & ")! Using default"
    If OptSkinName = "" Then OptSkinName = App.Path + "\default.skin"
        
    'Make the form visible
    Show
    
    'Set initial slider positions
    Balance = 0.5
    Sli(1).V = 0        'Track position slider轨道位置滑动器
    Sli(2).V = GetVol() 'Volume slider体积滑动器
    Sli(3).V = Balance  'Balance to centre平衡到中心
    Sli(4).V = Sli(2).V 'Volume indicator体积指示器
    Sli(5).V = 0.5      'Playback rate to 1x重放比率到1x
        
    'Initialize and Load Files
    ' 随机函数播种语句,Randomize 语句初始化随机数生成器,Randomize 用 Timer 函数的返回值作为新的随机数种子值
    Randomize Timer
    Call ClearInf
    Call LoadSkin(ByVal OptSkinName, True)
    Call LoadAutoList
    Call MakeDayStr

    If OptStartMin = 1 Then Me.Visible = False

    Load frmIcon 'system tray icon/menu
    
    'Handle file(s) from command-line
    'Command函数就是用来获取命令行参数的
    'CommandLine 返回完整的命令行
    If Command <> "" Then
        AddPath = Command
        AddName = "Commandline"
        AddTitle = MakeTitle(AddPath)
        Call PlAddFile
        TNum = 1
    Else
        'Perform Start运行开始
        Select Case OptStartMd
            Case 1: GoSub LoadLast
            Case 2
                AddPath = OptStartFile
                AddName = AddPath
                Call PlAddFile
        End Select
    End If
    Timer1.Enabled = True
    If OptAutoPlay = 1 Then Call PlayIt
    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"))
    End If
    F = GetSetting(Prg, Sect, "LastCover", "")
    If F <> "" Then LoadCover (F): PLCover = F
    Return

    
PLErr:
End Sub

'Clean up and save settings before exiting program
Private Sub Form_Unload(Cancel As Integer)
    CleanUP
    'save settings
    SaveSetting Prg, Sect, "Skin", OptSkinName
    SaveSetting Prg, Sect, "SkinPath", OptSkinPath
    SaveSetting Prg, Sect, "SkinImport", OptSkinImport
    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, "StartFile", OptStartFile
    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
    SaveSetting Prg, Sect, "ScrollName", OptScrollName
    SaveSetting Prg, Sect, "UseTagCover", OptUseTagCover
    SaveSetting Prg, Sect, "FriendlyNames", OptFriendly
    
    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))
    Call SetDD(6, SongName)
    Lbl(3).Caption = Left$(Time$, 5)
End Sub

'Main function dispatcher. Index corresponds to button number
Public 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 'Volume Down 5
        Case 8: Call VolUp 'Volume Up 5
        Case 9: Call VolMute 'Toggle Mute
        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
        '37-100 reserved
        Case 101 To 110: Call LoadSkin(ByVal Link(Index - 100), False) 'Load linked skin
        Case 111 To 120: Call WebLink(ByVal Link(Index - 110)) 'Do Web Link
    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当文件拖动到 playlist 对象的时 , 把文件加入 playlist
'_OLEDragDrop 当源部件决定放操作能发生，且源部件被放到目标部件时，此事件发生。
'注意 仅当 OLEDropMode 被设置为 1 (Manual) 时，此事件才发生。
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 As Integer)
    TmpBtn.Visible = False
    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)
Dim X As Long, Y As Long, W As Long, H As Long
Dim X2 As Integer, Y2 As Integer
    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
    TmpBtn.Refresh
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 mnuRect 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
        mnuRect.Left = 0: mnuRect.Top = 0
        mnuRect.Right = Screen.Width
        mnuRect.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, mnuRect)
    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
            'un-highlight previous button
            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)
Dim J As Integer, Ky As String, InFlag As Boolean
    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()
Dim n As Integer
    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