VB音乐播放器

VB音乐播放器外观 2010年04月29日 星期四 02:40 INCLUDEPICTURE "http://hiphotos.baidu.com/0512109051/pic/item/6180fcb30ad0b89fd8335a9b.jpg" \* MERGEFORMATINET 从上往下 依次为Form1、Form2、Form3.  对照我源代码可以实现音乐播放器的功能。 附: Access 数据库  文件名为         playlist.mdb 数据表名为;    playlist 字段为：   歌曲名、 歌曲存储地址、歌曲文件格式 VB音乐播放器源码 一 开发工具VB6.0    下面是Form1 代码 Option Explicit Const MAX_TOOLTIP As Integer = 64 Const NIF_ICON = &H2 Const NIF_MESSAGE = &H1 Const NIF_TIP = &H4 Const NIM_ADD = &H0 Const NIM_DELETE = &H2 Const WM_MOUSEMOVE = &H200 Const WM_LBUTTONDOWN = &H201 Const WM_LBUTTONUP = &H202 Const WM_LBUTTONDBLCLK = &H203 Const WM_RBUTTONDOWN = &H204 Const WM_RBUTTONUP = &H205 Const WM_RBUTTONDBLCLK = &H206 Const SW_RESTORE = 9 Const SW_HIDE = 0 Private Type NOTIFYICONDATA cbSize As Long hwnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * MAX_TOOLTIP End Type Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Private nfIconData As NOTIFYICONDATA '************************************************************************ ' '  上述代码处理隐藏功能 '  其和隐藏的Click事件  和 form1 的 Mouse_Move 事件联合实现隐藏功能 ' '*********************************************************************** Dim cell As String Dim playname As String Dim playtype As String Dim predatashowrow As Integer Dim openfirst As Boolean Private Sub addcmd_Click() Form2.Show vbModal End Sub Private Sub AddFoldCmd_Click() Form3.Left = (Screen.Width - Form3.Width) / 2 Form3.Top = (Screen.Height - Form3.Height) / 2 Form3.Show vbModal End Sub Private Sub datashow_RowColChange(LastRow As Variant, ByVal LastCol As Integer) playname = datashow.Columns("歌曲名").CellValue(datashow.Bookmark) cell = datashow.Columns("歌曲存储地址").CellValue(datashow.Bookmark) playtype = datashow.Columns("歌曲文件格式").CellValue(datashow.Bookmark) End Sub Private Sub DelCmd_Click() Dim adocnn As ADODB.Connection Dim adorst As ADODB.Recordset Dim cnnstr As String Dim mdbpath As String Dim sqlstr As String Set adocnn = New ADODB.Connection Set adorst = New ADODB.Recordset mdbpath = App.Path & "\playlist.mdb" cnnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbpath & ";Persist Security Info=False" sqlstr = "select * from playlist where 歌曲名='" & playname & "'" adocnn.Open cnnstr adorst.Open sqlstr, adocnn, adOpenKeyset, adLockOptimistic If Not adorst.EOF Then adorst.Delete adAffectCurrent adorst.Close adocnn.Close Call refreash_Click End Sub Private Sub Form_Load() '设定首次播放 openfirst = True '设定窗口位置 Form1.Left = (Screen.Width - Form1.Width) / 2 Form1.Top = (Screen.Height - Form1.Height) / 2 '上次退出时的文件处理 Dim lastpath As String   '定义存储最后文件路径 Dim lastplay As String   '定义存储读入内容 '禁用播放器右键功能 WindowsMediaPlayer1.enableContextMenu = False '上次播放歌曲记忆处理过程 lastpath = App.Path & "\lastplay.txt" Open lastpath For Input As #1 Do While Not EOF(1)   ' 循环至文件尾。 Line Input #1, lastplay   ' 读入一行数据并将其赋予某变量。 Loop Close #1 If lastplay <> "" Then WindowsMediaPlayer1.URL = lastplay Dim adocnn As New ADODB.Connection Dim adorst As New ADODB.Recordset Dim mdbpath As String Dim constr As String Dim sqlstr As String mdbpath = App.Path & "\playlist.mdb" constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbpath & ";Persist Security Info=False" sqlstr = "select * from playlist" Set adocnn = New ADODB.Connection Set adorst = New ADODB.Recordset adocnn.CursorLocation = adUseClient adocnn.Open constr adorst.Open sqlstr, adocnn, adOpenKeyset, adLockOptimistic adorst.Requery Set datashow.DataSource = adorst End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lMsg As Single lMsg = X / Screen.TwipsPerPixelX If lMsg = WM_RBUTTONUP Or lMsg = WM_LBUTTONUP Then Call Shell_NotifyIcon(NIM_DELETE, nfIconData) '退出图标 Me.Show End If End Sub Private Sub Form_Unload(Cancel As Integer) Dim laststr As String Dim lastplay As String Dim str As String str = "" laststr = App.Path & "\lastplay.txt" lastplay = WindowsMediaPlayer1.URL Open laststr For Output As #1 Print #1, str Close #1 Open laststr For Output As #1 Print #1, lastplay Close #1 End Sub Private Sub HideCmd_Click() nfIconData.hwnd = Me.hwnd nfIconData.uID = Me.Icon nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP nfIconData.uCallbackMessage = WM_MOUSEMOVE nfIconData.hIcon = Me.Icon.Handle nfIconData.szTip = "Vol Music" & vbNullChar nfIconData.cbSize = Len(nfIconData) Call Shell_NotifyIcon(NIM_ADD, nfIconData) ShowWindow Me.hwnd, SW_HIDE End Sub Private Sub playcmd_Click() Dim filename As String filename = cell & "\" & playname & "." & playtype WindowsMediaPlayer1.URL = filename WindowsMediaPlayer1.Controls.play End Sub Public Sub refreash_Click() Dim adocnn As ADODB.Connection Dim adorst As ADODB.Recordset Dim cnnstr As String Dim mdbpath As String Dim sqlstr As String Set adocnn = New ADODB.Connection Set adorst = New ADODB.Recordset adocnn.CursorLocation = adUseClient mdbpath = App.Path & "\playlist.mdb" adocnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbpath & ";Persist Security Info=False" sqlstr = "select * from playlist" adocnn.Open cnnstr adorst.Open sqlstr, adocnn, adOpenKeyset, adLockOptimistic Set datashow.DataSource = adorst End Sub Private Sub Timer1_Timer() Dim jcol As Integer Dim songname As String Dim songpath As String Dim songtype As String If WindowsMediaPlayer1.playState = 1 Then If openfirst = True Then datashow.Row = datashow.Row openfirst = False Else datashow.Row = datashow.Row + 1 End If For jcol = 0 To 2 If jcol = 0 Then songname = CStr(datashow.Columns(jcol).CellValue(datashow.Bookmark)) ElseIf jcol = 1 Then songpath = CStr(datashow.Columns(jcol).CellValue(datashow.Bookmark)) Else songtype = CStr(datashow.Columns(jcol).CellValue(datashow.Bookmark)) End If Next jcol WindowsMediaPlayer1.URL = songpath & "\" & songname & "." & songtype End If End Sub VB音乐播放器源代码 二 接下来是 Form2 代码： Option Explicit Private Sub addcmd_Click() Dim filetype As String Dim filename As String Dim i As Integer Dim filedir As String filetype = typecomb.Text filedir = Dirlist.Path If filetype = "*.mp3" Then filetype = "MP3" ElseIf filetype = "*.wma" Then filetype = "WMA" ElseIf filetype = "*.wav" Then filetype = "WAV" Else filetype = "MDI" End If filename = Filelist.filename If filename = "" Then MsgBox "你没有选择文件，请重新选择！", vbOKOnly, "提示" Exit Sub End If i = InStr(1, filename, ".") filename = Left(filename, i - 1) Dim adocnn As ADODB.Connection Dim adorst As ADODB.Recordset Dim cnnstr As String Dim sqlstr As String Dim mdbpath As String Set adocnn = New ADODB.Connection Set adorst = New ADODB.Recordset adocnn.CursorLocation = adUseClient mdbpath = App.Path & "\playlist.mdb" cnnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbpath & ";Persist Security Info=False" sqlstr = "select * from playlist where  歌曲名='" & filename & "'" adocnn.Open cnnstr adorst.Open sqlstr, adocnn, adOpenKeyset, adLockOptimistic If adorst.RecordCount > 0 Then MsgBox "歌曲已经存在！", vbExclamation, "提示" Form2.filename.Text = "" Exit Sub End If adorst.AddNew adorst.Fields("歌曲名") = filename adorst.Fields("歌曲存储地址") = filedir adorst.Fields("歌曲文件格式") = filetype adorst.Update Form2.filename.Text = "" adorst.Close adocnn.Close End Sub Private Sub Dirlist_Change() Filelist.Path = Dirlist.Path filename.Text = "" End Sub Private Sub Drivelist_Change() Dirlist.Path = Drivelist.Drive filename.Text = "" End Sub Private Sub exitcmd_Click() Unload Me End Sub Private Sub Filelist_Click() filename.Text = Filelist.filename End Sub Private Sub Form_Load() Form2.Left = (Screen.Width - Form2.Width) / 2 Form2.Top = (Screen.Height - Form2.Height) / 2 Filelist.Pattern = "*.mp3" typecomb.Text = "*.mp3" typecomb.AddItem "*.mp3", 0 typecomb.AddItem "*.wma", 1 typecomb.AddItem "*.wav", 2 typecomb.AddItem "*.mdi", 3 End Sub Private Sub Form_Unload(Cancel As Integer) Call Form1.refreash_Click End Sub Private Sub typecomb_Click() Filelist.Pattern = typecomb.Text End Sub VB音乐播放器源代码 三 下面是Form3代码： Option Explicit Private Sub addcmd_Click() Dim songname As String Dim songpath As String Dim songtype As String Dim ilist As Integer Dim jlistmax As Integer Dim i As Integer Dim adocnn As ADODB.Connection Dim adorst As ADODB.Recordset Dim mdbpath As String Dim cnnstr As String Dim sqlstr As String Set adocnn = New ADODB.Connection Set adorst = New ADODB.Recordset adorst.CursorLocation = adUseClient mdbpath = App.Path & "\playlist.mdb" cnnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbpath & ";Persist Security Info=False" sqlstr = "Select * from playlist" adocnn.Open cnnstr adorst.Open sqlstr, adocnn, adOpenKeyset, adLockOptimistic jlistmax = Filelist.ListCount - 1 If typecomb.Text = "*.mp3" Then songtype = "MP3" ElseIf typecomb.Text = "*.wma" Then songtype = "WMA" ElseIf typecomb.Text = "*.mdi" Then songtype = "MDI" Else: typecomb.Text = "*.wav" songtype = "WAV" End If songpath = Dirlist.Path For ilist = 0 To jlistmax adorst.AddNew songname = Filelist.List(ilist) i = InStr(1, songname, ".") songname = Left(songname, i - 1) adorst.Fields("歌曲名") = songname adorst.Fields("歌曲存储地址") = songpath adorst.Fields("歌曲文件格式") = songtype adorst.Update Next ilist adorst.Close adocnn.Close Text1.Text = "" Call Form1.refreash_Click End Sub Private Sub cancelcmd_Click() Unload Me End Sub Private Sub Dirlist_Change() Filelist.Path = Dirlist.Path End Sub Private Sub Drivelist_Change() Dirlist.Path = Drivelist.Drive End Sub Private Sub Filelist_Click() Text1.Text = Filelist.filename End Sub Private Sub Form_Load() Filelist.Pattern = "*.mp3" typecomb.Text = "*.mp3" typecomb.AddItem "*.mp3", 0 typecomb.AddItem "*.wma", 1 typecomb.AddItem "*.wav", 2 typecomb.AddItem "*.mdi", 3 End Sub Private Sub typecomb_Click() Filelist.Pattern = typecomb.Text End Sub