对VB初学者来说,做MP3播放器最为难的是控件了:千辛万苦找来了一个控件,用起来却一点也不痛快——不是有时间限制,就是功能不齐全,除非你交钱!其实,我们不必舍近求远,WIN98就有一个宝贝:MediaPlayer!这个控件支持多种音乐格式,而且绝对免费,用它做出的MP3播放器最合适不过了! 方法如下: 新建标准EXE工程,窗体就用默认名称好了,Caption为“土人MP3”或别的,将其BorderStyle属性设为1,MinButton设为True;添加一个MediaPlayer控件、一个公共对话框和一个Text控件;接下来在窗体上画五个按钮,分别命名为:cmdPlay,cmdPause,cmdContinue,cmdNext,cmdStop,Caption依次为播放、暂停、继续、下一曲、停止。好,下面就是编写代码了:'初始化程序 Private Sub Form_Load() MediaPlayer1.Visible = False cmdPlay.BackColor = vbRed cmdPause.BackColor = vbRed cmdContinue.BackColor = vbRed cmdStop.BackColor = vbRed cmdNext.BackColor = vbRed cmdContinue.Enabled = False cmdPause.Enabled = False cmdStop.Enabled = False Text1.Text = "本播放器支持各种音乐格式。谢谢使用。 土人。" Text1.BackColor = vbBlack Text1.ForeColor = vbYellow End Sub'播放 Private Sub cmdPlay_Click() Text1.SetFocus On Error GoTo handler With CommonDialog1 '.Flags = cdlOFNAllowMultiselect .InitDir = App.Path .Filter = "Midi Files(*.mid)|*.mid|MP3 Files(*.mp3)|*.mp3|Wave Filse(*.wav)|*.wav|(*.m3u)|*.m3u" .FileName = "" .ShowOpen End With MediaPlayer1.FileName = CommonDialog1.FileName MediaPlayer1.Play Text1.Text = " 现在正在播放:" & CommonDialog1.FileName cmdPlay.Enabled = False cmdPause.Enabled = True cmdContinue.Enabled = False cmdStop.Enabled = True Exit Sub handler: MsgBox "未选择媒体文件。", vbOKOnly, "错误信息" End Sub'暂停播放 Private Sub cmdPause_Click() Text1.SetFocus MediaPlayer1.Pause cmdPause.Enabled = False cmdContinue.Enabled = True End Sub'继续播放 Private Sub cmdContinue_Click() Text1.SetFocus MediaPlayer1.Play cmdPlay.Enabled = False cmdPause.Enabled = True cmdContinue.Enabled = False End Sub'播放下一曲 Private Sub cmdNext_Click() On Error GoTo NextErr '播放非m3u文件时只能播放单噬柚贸龃泶?br> MediaPlayer1.Next Exit Sub NextErr: MsgBox "现在正在播放单曲,没有一下曲。", vbOKOnly, "出错信息" End Sub'停止播放 Private Sub cmdStop_Click() MediaPlayer1.Stop cmdPlay.Enabled = True cmdPause.Enabled = False cmdContinue.Enabled = False cmdStop.Enabled = False End Sub 怎么样?代码不算多,一个自己的MP3播放器就做成了!这个MP3播放器只占用具2%的资源,播放质量并不见得比Winamp差,是不是很诱人? 说明: 1.*.m3u文件应该是大家所认识的,就是Winamp之类的播放器的播放文件列表,我们完全可以用记事本编辑它(打开一个此类的文件看看,没什么神秘的)。 2.以上程序在VB6.0,Win98第二版下调试通过。
快进 On Error GoTo err MediaPlayer1.CurrentPosition = MediaPlayer1.CurrentPosition + 10 err: 快退 On Error GoTo err MediaPlayer1.CurrentPosition = MediaPlayer1.CurrentPosition -10 err: 声道 再建一个模块: Private Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long Private Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long Private Declare Function waveOutGetVolume Lib "winmm.dll" ( _ ByVal uDeviceID As Long, _ lpdwVolume As Long _ ) As Long Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Type VolumeSetting LeftVol As Integer RightVol As Integer End TypePublic Const HIGHEST_VOLUME_SETTING = 12 Public Const WAVE_MAPPER = -1& '下面是获取音量的函数: Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long Dim bReturnValue As Boolean Dim Volume As VolumeSetting Dim lAPIReturnVal As Long Dim lBothVolumes As Long lAPIReturnVal = waveOutGetVolume(lDeviceID, lBothVolumes) lDataLen = Len(Volume) CopyMemory Volume.LeftVol, lBothVolumes, lDataLen lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535 lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535 lGetVolume = lAPIReturnVal End Function'下面是设置音量的函数: Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long Dim bReturnValue As Boolean Dim Volume As VolumeSetting Dim lAPIReturnVal As Long Dim lBothVolumes As Long Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING) Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING) lDataLen = Len(Volume) CopyMemory lBothVolumes, Volume.LeftVol, lDataLen lAPIReturnVal = waveOutSetVolume(lDeviceID, lBothVolumes) lSetVolume = lAPIReturnVal End Function'** -> * 转换函数 Public Function nSigned(ByVal lUnsignedInt As Long) As Integer Dim nReturnVal As Integer If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then MsgBox "Error in conversion from Unsigned to nSigned Integer" nSignedInt = 0 Exit Function End If If lUnsignedInt > 32767 Then nReturnVal = lUnsignedInt - 65536 Else nReturnVal = lUnsignedInt End If nSigned = nReturnVal End Function '转换函数 Public Function lUnsigned(ByVal nSignedInt As Integer) As Long Dim lReturnVal As Long If nSignedInt < 0 Then lReturnVal = nSignedInt + 65536 Else lReturnVal = nSignedInt End IfIf lReturnVal > 65535 Or lReturnVal < 0 Then MsgBox "Error in conversion from nSigned to Unsigned Integer" lReturnVal = 0 End If lUnsigned = lReturnValEnd Function 左 On Error GoTo err Dim L As Long, lleft As Long, lright As Long lleft = lUnsigned(0) lright = lUnsigned(HIGHEST_VOLUME_SETTING) L = lSetVolume(lleft, lright, WAVE_MAPPER) err: 右: On Error GoTo err Dim L As Long, lleft As Long, lright As Long lleft = lUnsigned(HIGHEST_VOLUME_SETTING) lright = lUnsigned(0)
= lSetVolume(lleft, lright, WAVE_MAPPER) err: 混合 On Error GoTo err Dim L As Long, lleft As Long, lright As Long lleft = lUnsigned(12) lright = lUnsigned(12)
对VB初学者来说,做MP3播放器最为难的是控件了:千辛万苦找来了一个控件,用起来却一点也不痛快——不是有时间限制,就是功能不齐全,除非你交钱!其实,我们不必舍近求远,WIN98就有一个宝贝:MediaPlayer!这个控件支持多种音乐格式,而且绝对免费,用它做出的MP3播放器最合适不过了! 方法如下: 新建标准EXE工程,窗体就用默认名称好了,Caption为“土人MP3”或别的,将其BorderStyle属性设为1,MinButton设为True;添加一个MediaPlayer控件、一个公共对话框和一个Text控件;接下来在窗体上画五个按钮,分别命名为:cmdPlay,cmdPause,cmdContinue,cmdNext,cmdStop,Caption依次为播放、暂停、继续、下一曲、停止。好,下面就是编写代码了:'初始化程序
Private Sub Form_Load()
MediaPlayer1.Visible = False
cmdPlay.BackColor = vbRed
cmdPause.BackColor = vbRed
cmdContinue.BackColor = vbRed
cmdStop.BackColor = vbRed
cmdNext.BackColor = vbRed
cmdContinue.Enabled = False
cmdPause.Enabled = False
cmdStop.Enabled = False
Text1.Text = "本播放器支持各种音乐格式。谢谢使用。 土人。"
Text1.BackColor = vbBlack
Text1.ForeColor = vbYellow
End Sub'播放
Private Sub cmdPlay_Click()
Text1.SetFocus
On Error GoTo handler
With CommonDialog1
'.Flags = cdlOFNAllowMultiselect
.InitDir = App.Path
.Filter = "Midi Files(*.mid)|*.mid|MP3 Files(*.mp3)|*.mp3|Wave Filse(*.wav)|*.wav|(*.m3u)|*.m3u"
.FileName = ""
.ShowOpen
End With
MediaPlayer1.FileName = CommonDialog1.FileName
MediaPlayer1.Play
Text1.Text = " 现在正在播放:" & CommonDialog1.FileName
cmdPlay.Enabled = False
cmdPause.Enabled = True
cmdContinue.Enabled = False
cmdStop.Enabled = True
Exit Sub
handler:
MsgBox "未选择媒体文件。", vbOKOnly, "错误信息"
End Sub'暂停播放
Private Sub cmdPause_Click()
Text1.SetFocus
MediaPlayer1.Pause
cmdPause.Enabled = False
cmdContinue.Enabled = True
End Sub'继续播放
Private Sub cmdContinue_Click()
Text1.SetFocus
MediaPlayer1.Play
cmdPlay.Enabled = False
cmdPause.Enabled = True
cmdContinue.Enabled = False
End Sub'播放下一曲
Private Sub cmdNext_Click()
On Error GoTo NextErr '播放非m3u文件时只能播放单噬柚贸龃泶?br> MediaPlayer1.Next
Exit Sub
NextErr:
MsgBox "现在正在播放单曲,没有一下曲。", vbOKOnly, "出错信息"
End Sub'停止播放
Private Sub cmdStop_Click()
MediaPlayer1.Stop
cmdPlay.Enabled = True
cmdPause.Enabled = False
cmdContinue.Enabled = False
cmdStop.Enabled = False
End Sub
怎么样?代码不算多,一个自己的MP3播放器就做成了!这个MP3播放器只占用具2%的资源,播放质量并不见得比Winamp差,是不是很诱人? 说明: 1.*.m3u文件应该是大家所认识的,就是Winamp之类的播放器的播放文件列表,我们完全可以用记事本编辑它(打开一个此类的文件看看,没什么神秘的)。 2.以上程序在VB6.0,Win98第二版下调试通过。
On Error GoTo err
MediaPlayer1.CurrentPosition = MediaPlayer1.CurrentPosition + 10
err:
快退
On Error GoTo err
MediaPlayer1.CurrentPosition = MediaPlayer1.CurrentPosition -10
err:
声道
再建一个模块:
Private Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Function waveOutGetVolume Lib "winmm.dll" ( _
ByVal uDeviceID As Long, _
lpdwVolume As Long _
) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Type VolumeSetting
LeftVol As Integer
RightVol As Integer
End TypePublic Const HIGHEST_VOLUME_SETTING = 12
Public Const WAVE_MAPPER = -1&
'下面是获取音量的函数:
Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
Dim bReturnValue As Boolean
Dim Volume As VolumeSetting
Dim lAPIReturnVal As Long
Dim lBothVolumes As Long
lAPIReturnVal = waveOutGetVolume(lDeviceID, lBothVolumes)
lDataLen = Len(Volume)
CopyMemory Volume.LeftVol, lBothVolumes, lDataLen
lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535
lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535
lGetVolume = lAPIReturnVal
End Function'下面是设置音量的函数:
Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
Dim bReturnValue As Boolean
Dim Volume As VolumeSetting
Dim lAPIReturnVal As Long
Dim lBothVolumes As Long
Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)
lDataLen = Len(Volume)
CopyMemory lBothVolumes, Volume.LeftVol, lDataLen
lAPIReturnVal = waveOutSetVolume(lDeviceID, lBothVolumes)
lSetVolume = lAPIReturnVal
End Function'** -> * 转换函数
Public Function nSigned(ByVal lUnsignedInt As Long) As Integer
Dim nReturnVal As Integer
If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
MsgBox "Error in conversion from Unsigned to nSigned Integer"
nSignedInt = 0
Exit Function
End If
If lUnsignedInt > 32767 Then
nReturnVal = lUnsignedInt - 65536
Else
nReturnVal = lUnsignedInt
End If
nSigned = nReturnVal
End Function
'转换函数
Public Function lUnsigned(ByVal nSignedInt As Integer) As Long
Dim lReturnVal As Long
If nSignedInt < 0 Then
lReturnVal = nSignedInt + 65536
Else
lReturnVal = nSignedInt
End IfIf lReturnVal > 65535 Or lReturnVal < 0 Then
MsgBox "Error in conversion from nSigned to Unsigned Integer"
lReturnVal = 0
End If
lUnsigned = lReturnValEnd Function 左
On Error GoTo err
Dim L As Long, lleft As Long, lright As Long
lleft = lUnsigned(0)
lright = lUnsigned(HIGHEST_VOLUME_SETTING)
L = lSetVolume(lleft, lright, WAVE_MAPPER)
err:
右:
On Error GoTo err
Dim L As Long, lleft As Long, lright As Long
lleft = lUnsigned(HIGHEST_VOLUME_SETTING)
lright = lUnsigned(0)
= lSetVolume(lleft, lright, WAVE_MAPPER)
err:
混合
On Error GoTo err
Dim L As Long, lleft As Long, lright As Long lleft = lUnsigned(12)
lright = lUnsigned(12)
L = lSetVolume(lleft, lright, WAVE_MAPPER)
err: