musiclist.frm

这个播放器是自己做的

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form16 
   BorderStyle     =   0  'None
   Caption         =   "Form16"
   ClientHeight    =   3090
   ClientLeft      =   150
   ClientTop       =   540
   ClientWidth     =   4680
   LinkTopic       =   "Form16"
   LockControls    =   -1  'True
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog cd1 
      Left            =   2160
      Top             =   1320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "*.m3u(播放列表文件)|*.m3u"
   End
   Begin VB.FileListBox Mp3file 
      Height          =   450
      Left            =   3600
      TabIndex        =   5
      Top             =   840
      Visible         =   0   'False
      Width           =   855
   End
   Begin MSComctlLib.ListView ListView1 
      Height          =   375
      Left            =   0
      TabIndex        =   4
      Top             =   0
      Width           =   615
      _ExtentX        =   1085
      _ExtentY        =   661
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      HideColumnHeaders=   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Appearance      =   0
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "歌曲名"
         Object.Width           =   2646
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "文件位置"
         Object.Width           =   2646
      EndProperty
   End
   Begin VB.PictureBox Savemig 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   3120
      ScaleHeight     =   615
      ScaleWidth      =   495
      TabIndex        =   3
      Top             =   1800
      Width           =   495
   End
   Begin VB.PictureBox Delmig 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   2040
      ScaleHeight     =   615
      ScaleWidth      =   495
      TabIndex        =   2
      Top             =   1800
      Width           =   495
   End
   Begin VB.PictureBox Addmig 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   960
      ScaleHeight     =   615
      ScaleWidth      =   495
      TabIndex        =   1
      Top             =   1800
      Width           =   495
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   855
      Left            =   0
      ScaleHeight     =   57
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   121
      TabIndex        =   0
      Top             =   0
      Width           =   1815
   End
   Begin VB.Menu openfile 
      Caption         =   "打开"
      Visible         =   0   'False
      Begin VB.Menu openA 
         Caption         =   "打开一个文件"
      End
      Begin VB.Menu opensome 
         Caption         =   "打开多个文件"
      End
      Begin VB.Menu openlist 
         Caption         =   "打开列表文件"
      End
   End
   Begin VB.Menu delfile 
      Caption         =   "删除"
      Visible         =   0   'False
      Begin VB.Menu delA 
         Caption         =   "删除一个文件"
      End
      Begin VB.Menu delSOME 
         Caption         =   "删除所有文件"
      End
   End
End
Attribute VB_Name = "Form16"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Meskin As String

Private Sub Addmig_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Static Onmig As Boolean
With Addmig
'模拟MouseOut事件
  If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
    ReleaseCapture
    Onmig = False
    Set .Picture = LoadPicture(App.Path & "\mp3\add1.gif")
  Else
    SetCapture .hwnd
    If Onmig = False Then
      Set .Picture = LoadPicture(App.Path & "\mp3\add2.gif")
      Onmig = True
    End If
  End If
End With

End Sub

Private Sub Addmig_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button <> 1 Then
  Exit Sub
End If
PopupMenu openfile

End Sub

Private Sub delA_Click()

If ListView1.ListItems.Count <> 0 Then
  If ListView1.selectedItem.Selected Then
    If ListView1.selectedItem.Index = Form11.MusicIndex Then
      If Form11.MusicIndex <> 1 Then
        Form11.MusicIndex = Form11.MusicIndex - 1
      ElseIf Form11.MusicIndex < ListView1.ListItems.Count - 1 Then
        Form11.MusicIndex = Form11.MusicIndex + 1
      ElseIf Form11.MusicIndex = ListView1.ListItems.Count - 1 Then
        Form11.MusicIndex = ListView1.ListItems.Count - 1
      Else
        Form11.MusicIndex = 0
      End If
    End If
    ListView1.ListItems.Remove ListView1.selectedItem.Index
    If ListView1.ListItems.Count = 0 Then
      Form11.Qianmig.Enabled = False
      Form11.Nextmig.Enabled = False
    End If
    If Form11.MusicIndex = 1 Then
      Form11.Qianmig.Enabled = False
    End If
    If Form11.MusicIndex = ListView1.ListItems.Count Then
      Form11.Nextmig.Enabled = False
    End If
  End If
End If

End Sub

Private Sub Delmig_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Static Onmig As Boolean
With Delmig
'模拟MouseOut事件
  If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
    ReleaseCapture
    Onmig = False
    Set .Picture = LoadPicture(App.Path & "\mp3\del1.gif")
  Else
    SetCapture .hwnd
    If Onmig = False Then
      Set .Picture = LoadPicture(App.Path & "\mp3\del2.gif")
      Onmig = True
    End If
  End If
End With

End Sub

Private Sub Delmig_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button <> 1 Then
  Exit Sub
End If
PopupMenu delfile

End Sub

Private Sub delSOME_Click()

ListView1.ListItems.Clear
Form11.Qianmig.Enabled = False
Form11.Nextmig.Enabled = False
Form11.MusicIndex = 0

End Sub

Private Sub Form_Load()

Meskin = "红粉菲菲"

End Sub

Private Sub ListView1_DblClick()

If ListView1.ListItems.Count <> 0 Then
  If ListView1.selectedItem.Selected Then
    With Form11
      .wmp.URL = ListView1.selectedItem.SubItems(1)
      .sta = True
      .Timer1.Interval = 1000
      .Statemig1.Picture = LoadPicture(App.Path & "\mp3\state1-1.gif")
      .Statemig2.Picture = LoadPicture(App.Path & "\mp3\state2-2.gif")
      .Statemig3.Picture = LoadPicture(App.Path & "\mp3\state3-2.gif")
      .Playmig.Enabled = True
      .Stopmig.Enabled = True
      .Playmig.Picture = LoadPicture(App.Path & "\mp3\pause1.gif")
      .MusicIndex = ListView1.selectedItem.Index
    End With
  End If
End If

End Sub

Private Sub openA_Click()

On Error GoTo er
With Form11
  .cd1.ShowOpen
  ListView1.ListItems.Add , , .cd1.FileTitle
  ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(1) = .cd1.FileName
  Form11.Playmig.Enabled = True
End With
Exit Sub
er:

End Sub

Private Sub openlist_Click()

On Error GoTo er
Dim tf As TextStream
Dim ans As String
Dim j As Integer
j = 0
cd1.ShowOpen
Set tf = Fso.OpenTextFile(cd1.FileName)
tf.ReadLine
Do Until tf.AtEndOfLine
  ans = Mid(tf.ReadLine, 11)
  ListView1.ListItems.Add , , ans
  ans = tf.ReadLine
  ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(1) = ans
  tf.ReadLine
  j = j + 1
Loop
tf.Close
Set tf = Nothing
If j > 1 Then
  Form11.Nextmig.Enabled = True
  Form11.Playmig.Enabled = True
End If
Exit Sub
er:

End Sub

Private Sub opensome_Click()

Form19.Show 1

End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
  ReleaseCapture
  SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If

End Sub

Private Sub Savemig_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Static Onmig As Boolean
With Savemig
'模拟MouseOut事件
  If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
    ReleaseCapture
    Onmig = False
    Set .Picture = LoadPicture(App.Path & "\mp3\save1.gif")
  Else
    SetCapture .hwnd
    If Onmig = False Then
      Set .Picture = LoadPicture(App.Path & "\mp3\save2.gif")
      Onmig = True
    End If
  End If
End With

End Sub

Private Sub Savemig_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button <> 1 Then
  Exit Sub
End If
On Error GoTo er
Dim tf As TextStream
Dim i As Integer
Dim ans As String
cd1.ShowSave
If Fso.FileExists(cd1.FileName) = True Then
  ans = MsgBox("文件已经存在，是否要替换现有文件")
  If ans = vbCancel Then
    Exit Sub
  End If
End If
Set tf = Fso.CreateTextFile(cd1.FileName, True)
tf.WriteLine "#EXTM3U"
For i = 1 To ListView1.ListItems.Count
  tf.WriteLine "#EXTINF:0," & ListView1.ListItems.Item(i).Text
  tf.WriteLine ListView1.ListItems.Item(i).SubItems(1)
  tf.WriteBlankLines 1
Next
Exit Sub
er:

End Sub