frmvisloader.frm

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

VERSION 5.00
Begin VB.Form frmVisLoader 
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   3945
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   9705
   LinkTopic       =   "Form1"
   ScaleHeight     =   263
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   647
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdPrnt 
      Caption         =   "Prnt"
      Height          =   375
      Left            =   5325
      TabIndex        =   14
      Top             =   3450
      Width           =   510
   End
   Begin VB.CommandButton cmdBg 
      Caption         =   "Bg"
      Height          =   375
      Left            =   4890
      TabIndex        =   13
      Top             =   3450
      Width           =   420
   End
   Begin VB.CheckBox chkSetDef 
      BackColor       =   &H00000000&
      Caption         =   "Set as Default"
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   3510
      TabIndex        =   12
      Top             =   3540
      Width           =   1350
   End
   Begin VB.CommandButton cSelDir 
      Caption         =   "&Select Dir"
      Height          =   360
      Left            =   2535
      TabIndex        =   10
      Top             =   3450
      Width           =   945
   End
   Begin VB.CommandButton cNext 
      Caption         =   "Pg &Dn"
      Height          =   360
      Left            =   1695
      TabIndex        =   6
      Top             =   3450
      Width           =   720
   End
   Begin VB.CommandButton cCancel 
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   360
      Left            =   75
      TabIndex        =   5
      Top             =   3465
      Width           =   810
   End
   Begin VB.ListBox FileList 
      BackColor       =   &H00000000&
      ForeColor       =   &H0000C000&
      Height          =   600
      Left            =   4035
      TabIndex        =   4
      Top             =   510
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.ListBox Dummy 
      BackColor       =   &H00000000&
      ForeColor       =   &H0000C000&
      Height          =   600
      Left            =   4035
      TabIndex        =   3
      Top             =   1215
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.CommandButton cPrev 
      Caption         =   "Pg &Up"
      Height          =   360
      Left            =   960
      TabIndex        =   2
      Top             =   3450
      Width           =   720
   End
   Begin VB.ListBox PlayList 
      Appearance      =   0  'Flat
      BackColor       =   &H00000000&
      ForeColor       =   &H0000C000&
      Height          =   1470
      ItemData        =   "frmVisLoader.frx":0000
      Left            =   6015
      List            =   "frmVisLoader.frx":0007
      TabIndex        =   1
      Top             =   675
      Width           =   3540
   End
   Begin VB.CommandButton cLoad 
      Caption         =   "&Load"
      Height          =   360
      Left            =   6000
      TabIndex        =   0
      Top             =   3465
      Width           =   3525
   End
   Begin VB.Label lPgStat 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Page:"
      ForeColor       =   &H0000FFFF&
      Height          =   195
      Left            =   945
      TabIndex        =   11
      Top             =   3195
      Width           =   420
   End
   Begin VB.Image iPic 
      Height          =   1350
      Index           =   0
      Left            =   135
      Stretch         =   -1  'True
      Top             =   465
      Width           =   1350
   End
   Begin VB.Label PName 
      BackStyle       =   0  'Transparent
      Caption         =   "<-"
      ForeColor       =   &H00FFFFFF&
      Height          =   285
      Left            =   6060
      TabIndex        =   9
      Top             =   375
      Width           =   3540
   End
   Begin VB.Label lPlHeader 
      BackColor       =   &H0000C000&
      Caption         =   "Selected Playlist:"
      Height          =   240
      Left            =   6045
      TabIndex        =   8
      Top             =   75
      Width           =   3540
   End
   Begin VB.Label lblVPS 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "VB-Amp Visual Playlist Selector"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000E&
      Height          =   435
      Left            =   75
      TabIndex        =   7
      Top             =   15
      Width           =   5055
   End
End
Attribute VB_Name = "frmVisLoader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Visual Playlist Selector (VPS)
' ========================
' Displays up to 16 thumbnails corresponding to playlist files
' If a playlist does not have a bitmap the "nocover.bmp" file
' will be shown. If a ".DIR" file is found only those directories
' will appear (used to categorize playlists by artist or genre).

Public Page As Integer, SelName As String, DefPic As String
Public MaxPage As Integer, LastPic As Integer
Public Busy As Boolean

Const MaxPic = 16 'maximum number of bitmaps to view

'Initialize elements etc
Private Sub Form_Load()
    Busy = True
    
    LastPic = 0
    Me.WindowState = 2 'Make window fill screen
    Me.Show: DoEvents  'display the window now
    
    W = Me.ScaleWidth: H = Me.ScaleHeight
    HH = H - 35: Sz = (HH - 60) \ 4
    PP = Sz * 4 + 20: PW = W - PP
    
    'Move the buttons to the bottom of the screen
    cLoad.Move PP, HH, PW
    cCancel.Top = HH
    cPrev.Top = HH: cNext.Top = HH
    cSelDir.Top = HH: cmdPrnt.Top = HH: cmdBg.Top = HH
    chkSetDef.Top = HH + 4
    lPgStat.Top = HH - 16
    
    'Move Playlist to far right
    lPlHeader.Left = PP: lPlHeader.Width = PW
    PName.Left = PP: PName.Width = PW
    PlayList.Move PP, 45, PW, HH - 60
    
    'Create image objects to hold bitmap covers
    iPic(0).Move 0, 0, Sz - 10, Sz - 10
    For J = 1 To MaxPic - 1: Load iPic(J): Next
    
    'Arrange images in 4 by 4 matrix
    For J = 0 To 3
        For K = 0 To 3
            iPic(J * 4 + K).Move K * Sz + 5, J * Sz + 35
        Next K
    Next J
    
    'Check for default playlist bitmap
    F$ = App.Path + "\nocover.bmp"
    If Exists(F$) = True Then DefPic = F$
    
    Path$ = OptVisPLPath 'initial directory from preferences
    If Path$ = "" Then Path$ = App.Path
        
    'Load and display initial playlists
    Call GetVPSDir(Path$)
    
End Sub

'Exit and unload
Private Sub cCancel_Click()
    If Busy = False Then
        Call AlwaysOnTop(frmVBAmp, OptAlwaysOnTop)
        Unload Me
    End If
End Sub

' Select new directory and load playlists
Private Sub cSelDir_Click()
    A$ = GetBrowseDir(Me, "Select directory containing media files:")
    If A$ <> "" Then Call GetVPSDir(A$)
End Sub

'Get the directory and display it
Private Sub GetVPSDir(A$)
    Busy = True
    Path$ = ValidateDir(A$)
    If Exists(Path$ & "nul") = False Then Exit Sub
    Call ClearVPS
    DD$ = Dir$(Path$ & "*.DIR")
    If DD$ <> "" Then
        'Directory contains ".DIR" file so only add it/them
        Do
          FileList.AddItem Path$ & DD$ 'add one
          DD$ = Dir$ 'get the next
        Loop While DD$ <> ""
    Else
        'Add all playlists in this folder and all subfolders
        Call AddDir(Path$, Me, Dummy, FileList, "M3U PLS")
    End If
    Page = 0: Call ShowPage
    If chkSetDef.Value = 1 Then OptVisPLPath = Path$
    Busy = False
End Sub

'Go to next page
Private Sub cNext_Click()
    If Page < MaxPage Then Page = Page + 1: Call ShowPage
End Sub

'Go to previous page
Private Sub cPrev_Click()
    If Page > 0 Then Page = Page - 1: Call ShowPage
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Busy = True Then Cancel = True
End Sub

'Load selected playlist and exit
Private Sub iPic_DblClick(Index As Integer)
    Call LoadPlayList(Index)
    Call LoadIt
End Sub

'Load the playlist then exit
Private Sub cLoad_Click()
    Call LoadIt
End Sub

'Load selected playlist for viewing
Private Sub iPic_Click(Index As Integer)
    Call LoadPlayList(Index)
End Sub

'Highlight the bitmap by turning on border, un-highlight previous image
Private Sub iPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Index <> LastPic Then
        iPic(LastPic).BorderStyle = 0
        iPic(Index).BorderStyle = 1
        LastPic = Index
    End If
End Sub

'Un-Highlight previous image
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If LastPic <> 0 Then
        iPic(LastPic).BorderStyle = 0
        LastPic = 0
    End If
End Sub

'Clear all lists and set help message
Private Sub ClearVPS()
    FileList.Clear: Dummy.Clear
    PlayList.Clear
    PName.Caption = "<- Select playlist from left"
End Sub

'Load the specified playlist for Viewing only
Private Sub LoadPlayList(ByVal Index As Integer)
    n = Page * MaxPic + Index
    If n > FileList.ListCount - 1 Then Exit Sub
    
    Filename = FileList.List(n)

    PlayList.Clear
    PName.Caption = MakeTitle(GetFileName(Filename))
    SelName = Filename
    
    If UCase$(Right$(SelName, 4)) = ".DIR" Then PlayList.AddItem "This is a directory. Double-click to enter!": Exit Sub
    
    FIO% = FreeFile
    Open Filename For Input As FIO%
    Do While Not EOF(FIO%)
        Line Input #FIO%, A$
        PlayList.AddItem GetFileName(A$)
    Loop
    Close FIO%
End Sub

'Load selected playlist into main form, play it, and exit screen
Private Sub LoadIt()
    If UCase$(Right$(SelName, 4)) = ".DIR" Then
        A$ = Left$(SelName, Len(SelName) - 4)
        If A$ <> "" Then Call GetVPSDir(A$)
    Else
        Call frmVBAmp.PlClear
        Call frmVBAmp.PlRead(SelName)
        Call frmVBAmp.PlayIt
        Unload Me
    End If
End Sub

'Display one page of playlist bitmaps
Private Sub ShowPage()
    
    Me.MousePointer = 11
    PlayList.Clear
    PName.Caption = "One moment, loading..."
    DoEvents
    
    n = Page * MaxPic
    Max = FileList.ListCount - 1
    MaxPage = Max \ MaxPic
    
    lPgStat.Caption = "Page " & Str$(Page + 1) & " of " & Str$(MaxPage + 1) & ".  Total Playlists:" & Str$(Max + 1)
    
    For J = 0 To MaxPic - 1
        If CancelFlag = True Then Exit For
        Num = n + J
        If Num <= Max Then
            F$ = GetBaseName(FileList.List(Num))
            GoSub FindPic
        Else
            iPic(J).Visible = False
        End If
        DoEvents
    Next J
    Me.MousePointer = 0
    PName.Caption = "Select playlist..."
    Busy = False
Exit Sub

FindPic:
  C$ = FindCover$(F$)
  If C$ <> "" Then
    iPic(J).Picture = LoadPicture(C$)
  Else
    If DefPic = "" Then
        iPic(J).Picture = Nothing
    Else
        iPic(J).Picture = LoadPicture(DefPic)
    End If
  End If
  
  iPic(J).ToolTipText = MakeTitle(F$)
  iPic(J).Visible = True
  
  Return
  
TestIt:
 If Exists(FF$) = True Then C$ = FF$
 Return

End Sub

Private Sub cmdBg_Click()
    c1 = &HFFFFFF: c2 = 0
    If Me.BackColor = 0 Then c2 = &HFFFFFF: c1 = 0
       
    chkSetDef.BackColor = c2
    chkSetDef.ForeColor = c1
    PlayList.BackColor = c2
    PlayList.ForeColor = c1
    lblVPS.ForeColor = c1
    PName.ForeColor = c1
    Me.BackColor = c2
    
End Sub

Private Sub cmdPrnt_Click()
    Me.PrintForm
End Sub