mci.bas

vb 写的播放器 对新的开发者很有用。写的不错。非常实际

Attribute VB_Name = "Mci"

' **********************************************************************
'  描  述：存vb代码写的winnap程序，非常酷
'  Play78.com : 网站导航，源码之家，绝对开源
'  海阔天空收集整理
'  主站地址：http://www.play78.com/
'  源码下载地址：http://www.play78.com/blog
'  图片下在地址：http://www.play78.com/pic
'  QQ：13355575
'  e-mail:[e-mail]
'  编写日期：2005年08月30日
' **********************************************************************

Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Public MciPosition As String * 12
Public MciLength As String * 12
Public MciPositionTime
Public MciLengthTime
Public MciMode As String * 8
Public RecentSongName As String
Public PlayingName As String

Public PlayingSong As String '正在播放的文件


Public Sub GetMciInfo()
mciSendString "status Media1 position", MciPosition, Len(MciPosition), 0
Dim Min As Integer
Dim Sec As Integer
Min = Val(MciPosition) \ 1000 \ 60
Sec = Val(MciPosition) \ 1000 Mod 60
MciPositionTime = Min & ":" & Sec
If Sec < 10 Then MciPositionTime = Min & ":" & "0" & Sec
If Min < 10 Then MciPositionTime = "0" & MciPositionTime

mciSendString "status Media1 length", MciLength, Len(MciLength), 0
Dim Min1 As Integer
Dim Sec1 As Integer
Min1 = Val(MciLength) \ 1000 \ 60
Sec1 = Val(MciLength) \ 1000 Mod 60
MciLengthTime = Min1 & ":" & Sec1
If Sec1 < 10 Then MciLengthTime = Min1 & ":" & "0" & Sec1
If Min < 10 Then MciLengthTime = "0" & MciLengthTime
End Sub

Public Sub GetMciMode()
mciSendString "status Media1 mode", MciMode, Len(MciMode), 0
End Sub

Public Sub Play(ByVal FileName As String)
On Error GoTo Exit1
If Dir(FileName) = "" Then
 ChangeMusic
 Exit Sub
End If
PlayingSong = FileName
GetMciMode
If MciMode = "playing" & Chr(0) Then mciExecute ("close Media1")
mciExecute ("open " & FileName & " alias Media1")
mciExecute ("play Media1")
SetTrayTip Listfrm.List1.Text
Mainfrm.MainFrmTime.Enabled = True
Listfrm.ListFrmTime.Enabled = True
Mainfrm.Timer_Scrollbar.Enabled = True
Mainfrm.Change_Music.Enabled = True
Mainfrm.Label1.Caption = "   " & FileName & "   "
Exit1:
End Sub

Public Sub Pause()
GetMciMode
If MciMode = "playing" & Chr(0) Then mciExecute ("pause Media1")
End Sub

Public Sub OpenCDRom()
mciExecute "set cdaudio door open"
End Sub

Public Sub CloseCDRom()
mciExecute "set cdaudio door closed"
End Sub

Public Sub CloseIt()
GetMciMode
If MciMode = "paused" & Chr(0) & Chr(0) Or MciMode = "playing" & Chr(0) Then
 mciExecute ("close Media1")
 Mainfrm.Timer_Scrollbar.Enabled = False
End If
End Sub

Public Sub NextMusic()
If Listfrm.List1.ListCount = 0 Then Exit Sub
If Listfrm.List1.ListIndex = Listfrm.List1.ListCount - 1 Then
 Listfrm.List1.ListIndex = 0
 Listfrm.List2.ListIndex = 0
 Play Listfrm.List2.Text
Else
 Listfrm.List1.ListIndex = Listfrm.List1.ListIndex + 1
 Listfrm.List2.ListIndex = Listfrm.List2.ListIndex + 1
 Play Listfrm.List2.Text
End If
End Sub

Public Sub LastMusic()
If Listfrm.List1.ListIndex < 0 Then
 Exit Sub
ElseIf Listfrm.List1.ListIndex = 0 Then
 Play Listfrm.List2.Text
Else
 Listfrm.List1.ListIndex = Listfrm.List1.ListIndex - 1
 Listfrm.List2.ListIndex = Listfrm.List2.ListIndex - 1
 Play Listfrm.List2.Text
End If
End Sub

Public Sub ChangeMusic()
GetMciMode
If MciMode = "stopped" & Chr(0) Then
 mciExecute ("close Media1")
 If Mainfrm.ShuffleFlag = True Then '顺序模式
  If Mainfrm.RepFlag = True Then '非循环模式
   If Listfrm.List1.ListIndex = Listfrm.List1.ListCount - 1 Then Exit Sub '最后一首跳出
  End If
  If Listfrm.List1.ListIndex = Listfrm.List1.ListCount - 1 Then '如果最后一首，跳到第一首
   Listfrm.List1.ListIndex = 0
   Listfrm.List2.ListIndex = 0
  Else
   Listfrm.List1.ListIndex = Listfrm.List1.ListIndex + 1 '下一首
   Listfrm.List2.ListIndex = Listfrm.List2.ListIndex + 1 '下一首
  End If
 Else '随机模式
  Dim SongIndex As Integer
  SongIndex = Rnd * 10000 Mod Listfrm.List1.ListCount
  Listfrm.List1.ListIndex = SongIndex
  Listfrm.List2.ListIndex = SongIndex
 End If
 'mciExecute ("open " & Listfrm.List2.Text & " alias Media1")
 'mciExecute ("play Media1")
 'PlayingName = ListForm.List1.Text
 'RecentSongName = PlayingName & ".txt"
 'SetTrayTip PlayingName
 Play Listfrm.List2.Text
 
End If
End Sub


Public Sub AddSong1()
On Error GoTo Cancel
 ShowOpen , "支持的音频格式" + vbNullChar + "*.mp3;*.wav;*.mid;*.dat;*.mpg;*.mpeg;*.mov;*.cda" + vbNullChar + "*.mp3" + vbNullChar + "*.mp3" + vbNullChar + "*.wav " + vbNullChar + "*.wav" + vbNullChar + "*.dat" + vbNullChar + "*.dat" + vbNullChar + "*.mid" + vbNullChar + "*.mid" + vbNullChar + "列表文件" + vbNullChar + "*.m3u" + vbNullChar + "*.*" + vbNullChar + "*.*" + vbNullChar, Mainfrm.RecentDir
 If KuoZhanMing = "m3u" Then
  Readm3u FileName
 Else
  FName = FileName
  FTitle = PFileTitle
  Listfrm.List2.AddItem FName, Listfrm.List2.ListIndex + 1
  Listfrm.List1.AddItem FTitle, Listfrm.List1.ListIndex + 1
  Listfrm.List2.ListIndex = Listfrm.List2.ListIndex + 1
  Listfrm.List1.ListIndex = Listfrm.List1.ListIndex + 1
 End If
 Mainfrm.RecentDir = Left$(FileName, Len(FileName) - Len(FileTitle) - 1)
Cancel:
End Sub

Public Sub AddSong()
On Error GoTo Cancel
 ShowOpen , "支持的音频格式" + vbNullChar + "*.mp3;*.wav;*.mid;*.dat;*.mpg;*.mpeg;*.mov;*.cda" + vbNullChar + "*.mp3" + vbNullChar + "*.mp3" + vbNullChar + "*.wav " + vbNullChar + "*.wav" + vbNullChar + "*.dat" + vbNullChar + "*.dat" + vbNullChar + "*.mid" + vbNullChar + "*.mid" + vbNullChar + "列表文件" + vbNullChar + "*.m3u" + vbNullChar + "*.*" + vbNullChar + "*.*" + vbNullChar, Mainfrm.RecentDir
 FName = FileName
 If COMDLG.KuoZhanMing = "m3u" Then
  Listfrm.List1.Clear
  Listfrm.List2.Clear
  Readm3u FileName
 Else
  FTitle = PFileTitle
  Listfrm.List1.Clear
  Listfrm.List2.Clear
  Listfrm.List2.AddItem FName, 0
  Listfrm.List1.AddItem FTitle, 0
 End If
 Mainfrm.RecentDir = Left$(FileName, Len(FileName) - Len(FileTitle) - 1)
Cancel:
End Sub

Public Sub Writem3u(m3uFile As String)
Dim b, c As String
b = "#EXTM3U"
c = "#EXTINF:0,"
Open m3uFile For Output As #1
Print #1, b
For i = 0 To Listfrm.List1.ListCount - 1
 d = c & Listfrm.List1.List(i)
 Print #1, d
 Print #1, Listfrm.List2.List(i)
Next i
Close #1
End Sub

Public Sub Readm3u(m3uFile As String)
Open m3uFile For Input As #1
Dim line0 As String '#EXTM3U
Dim line1 As String '#EXTINF:0,
Dim line2 As String 'list1
Dim line3 As String 'list2
On Error GoTo Exit1
Input #1, line0
Do
 Input #1, line1
 Input #1, line2
 Input #1, line3
 Listfrm.List1.AddItem line2
 Listfrm.List2.AddItem line3
Loop Until EOF(1)
Exit1:
Close #1
End Sub

Public Sub KeyDown(ByVal KeyCode)
Select Case KeyCode
Case 37 'left
 GetMciMode
 If MciMode = "playing" & Chr(0) Then
  GetMciInfo
  If MciPosition < 5200 Then
   mciExecute ("play Media1 from " & 0)
  Else
   mciExecute ("play Media1 from " & MciPosition - 5000)
  End If
 End If
 
Case 39 'right
 GetMciMode
 If MciMode = "playing" & Chr(0) Then
  GetMciInfo
  If MciPosition > MciLength - 5200 Then
   mciExecute ("play Media1 from " & MciLength - 200)
  Else
   mciExecute ("play Media1 from " & MciPosition + 5000)
  End If
 End If

Case 66 'B
 GetMciMode
 If MciMode = "playing" & Chr(0) Then mciExecute ("close Media1")
 If Mainfrm.ShuffleFlag = True Then '顺序模式
  If Mainfrm.RepFlag = True Then '非循环模式
   If Listfrm.List1.ListIndex = Listfrm.List1.ListCount - 1 Then Exit Sub '最后一首跳出
  End If
  If Listfrm.List1.ListIndex = Listfrm.List1.ListCount - 1 Then '如果最后一首，跳到第一首
   Listfrm.List1.ListIndex = 0
   Listfrm.List2.ListIndex = 0
  Else
   Listfrm.List1.ListIndex = Listfrm.List1.ListIndex + 1 '下一首
   Listfrm.List2.ListIndex = Listfrm.List2.ListIndex + 1 '下一首
  End If
 Else '随机模式
  Dim SongIndex As Integer
  SongIndex = Rnd * 10000 Mod Listfrm.List1.ListCount
  Listfrm.List1.ListIndex = SongIndex
  Listfrm.List2.ListIndex = SongIndex
 End If
 Play Listfrm.List2.Text
 
Case 67 'C
 BitBlt Mainfrm.Playpaus.hDC, 0, 0, 10, 10, Mainfrm.Skin12.hDC, 9, 0, SRCCOPY
 Mainfrm.Playpaus.Refresh
 Pause
 
Case 88 'X
 BitBlt Mainfrm.Playpaus.hDC, 0, 0, 10, 10, Mainfrm.Skin12.hDC, 0, 0, SRCCOPY
 Mainfrm.Playpaus.Refresh
 
 GetMciMode
 If MciMode = "paused" & Chr(0) & Chr(0) Then
  mciExecute ("resume Media1")
 Else
  If Listfrm.List2.ListIndex = -1 Then Exit Sub
  Play Listfrm.List2.Text
 End If


 
End Select
End Sub