frmlist.frm

mp3播放器软件

      Width           =   75
   End
   Begin VB.Image skins 
      Height          =   225
      Index           =   5
      Left            =   0
      Picture         =   "frmList.frx":1F804
      Top             =   240
      Width           =   120
   End
   Begin VB.Image skins 
      Height          =   120
      Index           =   2
      Left            =   360
      Picture         =   "frmList.frx":1F9B0
      Top             =   0
      Width           =   105
   End
   Begin VB.Image skins 
      Height          =   75
      Index           =   1
      Left            =   240
      Picture         =   "frmList.frx":1FAB4
      Stretch         =   -1  'True
      Top             =   0
      Width           =   15
   End
   Begin VB.Image skins 
      Height          =   120
      Index           =   0
      Left            =   0
      Picture         =   "frmList.frx":1FB38
      Top             =   0
      Width           =   90
   End
   Begin VB.Image bg 
      Height          =   375
      Left            =   120
      Picture         =   "frmList.frx":1FC1C
      Stretch         =   -1  'True
      Top             =   120
      Width           =   495
   End
End
Attribute VB_Name = "frmList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/15
'描    述：网页搜索音乐播放器  Ver 1.1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Implements ICustomDraw

Private Sub bg_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim icount As Integer
    For icount = 0 To 2
        If icount <> nowTab Then tab1(icount).Picture = tab3(icount).Picture
    Next
End Sub

Private Sub Form_Load()
    Me.Left = frmMain.Left: Me.Top = frmMain.Top + frmMain.Height '窗体启动时 与 主窗体 组合
    MOVL(0) = True
    Me.Width = frmMain.Width
    
    Dim I   As Long
    
    With playlist
        .Redraw = False
        .AddColumn "id", "序号", 2, 35, True, True
        .AddColumn "l1", "", 2, 1, False, True
        .AddColumn "title", "歌名", 0, 145, True, True
        .AddColumn "l2", "", 2, 1, False, True
        .AddColumn "artist", "歌手", 1, 50, True, True
        .AddColumn "l3", "", 2, 1, False, True
        .AddColumn "time", "时间", 2, 45, True, True
        .AddColumn "filaname", "", 2, 0, True, False
    End With

   ' playList.BackColor = RGB(255, 255, 255)
    'playList.FocusRectColor = RGB(142, 217, 253)
    'playlist.columnsVisible = True
    playlist.ColumnsAutoSize = True
    Set playlist.DrawCallback = Me
    
    playlist.Redraw = True
    
    nowTab = 0
    
    
    '加载播放列表
    Dim j As Integer
    j = 0
    Dim a As String
    Dim b As String
    Dim C As String
    Dim d As String

    If Dir(App.path & "\default.lst") <> "" Then
        Open App.path & "\default.lst" For Input As #1  ' 读取文件列表清单 M3U
        Do Until EOF(1)
            DoEvents
            Input #1, a$, b$, C$, d$
            addMusic j, a$, b$, C$, d$, False
            j = j + 1
        Loop
    End If
    
    frmList.Show
End Sub


Private Sub Form_Resize()
    On Error Resume Next
    '定义背景
    skins(0).Move 0, 0, skins(0).Width, skins(0).Height
    
    skins(1).Move skins(0).Width, 0, Me.Width - (skins(0).Width + skins(2).Width), skins(1).Height
    skins(2).Move skins(1).Width + skins(0).Width, 0, skins(2).Width, skins(2).Height
    
    skins(3).Move 0, skins(0).Height, skins(3).Width, Me.Height - (skins(0).Height + skins(5).Height)
    skins(4).Move Me.Width - skins(4).Width, skins(0).Height, skins(4).Width, Me.Height - (skins(2).Height + skins(7).Height)
    
    skins(5).Move 0, Me.Height - skins(5).Height, skins(5).Width, skins(5).Height
    skins(6).Move skins(5).Width, Me.Height - skins(6).Height, Me.Width - (skins(5).Width + skins(7).Width), skins(6).Height
    
    skins(7).Move Me.Width - skins(7).Width, Me.Height - skins(7).Height, skins(7).Width, skins(5).Height
    
    
     '列表边框
    bordertop.BorderColor = RGB(144, 182, 208)
    borderLeft.BorderColor = RGB(144, 182, 208)
    borderBottom.BorderColor = RGB(144, 182, 208)
    borderBottom1.BorderColor = RGB(144, 182, 208)
    borderRight.BorderColor = RGB(144, 182, 208)
    
    bordertop.X1 = 100
    bordertop.Y1 = 580
    bordertop.X2 = Me.Width - 100
    bordertop.Y2 = 580
    
    borderLeft.Y2 = Me.Height - borderLeft.X1 - 1500
    
    borderBottom.Y1 = borderLeft.Y2
    borderBottom.X2 = Me.Width - 100
    borderBottom.Y2 = borderBottom.Y1
    
    borderBottom1.Y1 = borderLeft.Y2 - 400
    borderBottom1.X2 = Me.Width - 100
    borderBottom1.Y2 = borderBottom.Y1 - 400
    
    borderRight.Y2 = borderLeft.Y2
    borderRight.X1 = borderBottom.X2
    borderRight.X2 = borderBottom.X2
    
    L1.Left = tab1(0).Left + tab1(0).Width + tab1(1).Width + tab1(2).Width
    
    bg.Move 0, 0, Me.Width, Me.Height

    '列表
    With playlist
        If Me.ScaleWidth - .Left * 2 > 0 Then .Width = borderBottom.X2 - 120
        If Me.ScaleHeight - (.Top + 8) * 2 > 0 Then .Height = borderLeft.Y2 - 1000
    End With
    
    '菜单背景按钮
    Dim mnui
    menuBg.Move borderBottom.X1 + 20, borderBottom1.Y1 + 30, borderBottom.X2 - menuBg.Left, menuBg.Height
    For mnui = 0 To 4
        mnu1(mnui).Top = menuBg.Top + 60
    Next
End Sub



Private Sub Image_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then X1 = X: Y1 = Y
End Sub


Private Sub Image_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Me.Top < frmMain.Top + frmMain.Height + 300 And Me.Top > frmMain.Top + frmMain.Height - 300 And Me.Left > frmMain.Left - 300 And Me.Left < frmMain.Left + 300 Then
       Me.Top = frmMain.Top + frmMain.Height
       Me.Left = frmMain.Left
       MOVL(0) = True     '播放列表 与 主窗体 移动
     Else
       MOVL(0) = False
     End If
End Sub

Private Sub L_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then  '弹出菜单
       Menu.Top = Y + Me.Top + 260
       Menu.Left = X + Me.Left + 200
       Menu.Show
    End If
End Sub


'菜单按钮离开还原
Private Sub menuBg_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim icount
    For icount = 0 To 4
        mnu1(icount).Picture = mnu2(icount).Picture
    Next
End Sub


'菜单按钮经过效果
Private Sub mnu1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    mnu1(Index).Picture = mnu3(Index).Picture
End Sub
'打开添加菜单
Private Sub mnu1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Select Case Index
            Case 0
                PopupMenu Menu.mnuAdd, 0, mnu1(Index).Left, mnu1(Index).Top + mnu1(Index).Height
            Case 1
                PopupMenu Menu.mnuDel, 0, mnu1(Index).Left, mnu1(Index).Top + mnu1(Index).Height
            Case 2
                PopupMenu Menu.mnuSort, 0, mnu1(Index).Left, mnu1(Index).Top + mnu1(Index).Height
            Case 3
                PopupMenu Menu.mnuMode, 0, mnu1(Index).Left, mnu1(Index).Top + mnu1(Index).Height
            Case 4
                PopupMenu Menu.mnuSame, 0, mnu1(Index).Left, mnu1(Index).Top + mnu1(Index).Height
        End Select
    End If
End Sub

Private Sub playList_DblClick(ByVal ItemIndex As Long)
    Dim I   As Long
    If playlist.itemCount > 0 And frmLrc.Text3.Visible = False Then
        frmMain.MP.url = playlist.ItemText(ItemIndex, 7)
        frmMain.MP.Controls.play
        
        firstPlay = True
        
        Song = ItemIndex  '将播放歌曲位置储存

        Songname = playlist.ItemText(Song, 1)
        Songpath = Mid(frmList.playlist.ItemText(Song, 7), 1, InStrRev(frmList.playlist.ItemText(Song, 7), "\"))
        
        frmMain.I1(2).Picture = frmMain.I2(3).Picture
    End If
    Mm = 0
End Sub

Private Sub playlist_MouseUp(ByVal ItemIndex As Long, ByVal MouseButton As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If MouseButton = 2 Then
        
    End If
End Sub

Private Sub playList_Reorder()
    Dim I   As Long
    
    For I = 0 To playlist.itemCount - 1
        If playlist.ItemTag(I) = 1 Then
            m_lngSel = I
            Exit For
        End If
    Next
End Sub

Private Sub skins_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '窗口大小
    On Error Resume Next
    If Button = 1 Then
        Select Case Index
            Case 7
                If Me.Height > 2880 Then
                    Me.Height = Me.Height + Y
                Else
                    Me.Height = 3000
                End If
                If Me.Width > 2880 Then
                    Me.Width = Me.Width + X
                    If L1.Width > 20 Then
                        L1.Width = L1.Width + (Me.Width - L1.Left)
                    Else
                        L1.Width = 23
                    End If
                Else
                    Me.Width = 3000
                End If
        End Select
    End If
End Sub

Private Sub tab1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim icount As Integer
    If Button = 1 Then
        For icount = 0 To 2
            If Index = icount Then
                tab1(Index).Picture = tab2(Index).Picture
            Else
                tab1(icount).Picture = tab3(icount).Picture
            End If
        Next
        nowTab = Index
    End If
End Sub

Private Sub tab1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim icount As Integer
    For icount = 0 To 2
        If nowTab <> icount Then
            If Index = icount Then
                tab1(Index).Picture = tab4(Index).Picture
            Else
                tab1(icount).Picture = tab3(icount).Picture
            End If
        End If
    Next
End Sub

'列表颜色
Private Function ICustomDraw_CustomDraw(ByVal ItemIndex As Long, ByVal ColumnIndex As Long, BackColor As Long, ForeColor As Long) As Boolean
    Dim blnSelected As Boolean
    Dim lngTag      As Long
        
    blnSelected = playlist.ItemSelected(ItemIndex)
    lngTag = playlist.ItemTag(ItemIndex)

    If ColumnIndex = 0 Then
        playlist.ItemText(ItemIndex, 0) = CStr(ItemIndex + 1)
    End If

    If lngTag = 1 Then  '正在播放的色
        ForeColor = RGB(85, 175, 18)
        BackColor = RGB(235, 242, 254)
        If blnSelected Then BackColor = RGB(38, 100, 199)
    Else
        If lngTag = 2 Then  '错误链接时的文字色
            ForeColor = RGB(255, 0, 0)
        Else
            '文字颜色
            ForeColor = RGB(76, 97, 143)
            
            '隔行背景色
            If ItemIndex Mod 2 Then
                BackColor = RGB(241, 249, 252)
            Else
                BackColor = vbWhite
            End If
            
            '选择时的背景色和文字色
            If blnSelected Then BackColor = RGB(38, 100, 199)
            If blnSelected Then ForeColor = RGB(255, 255, 255)
        End If
    End If
    
    If ColumnIndex = 1 Or ColumnIndex = 3 Or ColumnIndex = 5 Then
        BackColor = RGB(186, 214, 229)
    End If
    ICustomDraw_CustomDraw = True
End Function