永发信息网

VB mcisendstring让音乐循环播放

答案:2  悬赏:60  手机版
解决时间 2021-01-29 19:53
  • 提问者网友:孤凫
  • 2021-01-28 19:51
VB mcisendstring让音乐循环播放 给代码或提示下也行
最佳答案
  • 五星知识达人网友:举杯邀酒敬孤独
  • 2021-01-28 20:01
首先为当前窗体添加菜单(背景音乐的播放与暂停用菜单控制),将一个子菜单命名为"背景音乐",并勾中"复选";在窗体上放置一个时钟控件,更名为Timer0。窗体的完整代码如下。
Option Explicit
Private 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 GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciGetDeviceID Lib "winmm.dll" Alias "mciGetDeviceIDA" (ByVal lpstrName As String) As Long
Private Declare Function mciGetCreatorTask Lib "winmm.dll" (ByVal wDeviceID As Long) As Long
Dim SOUNDNAME As String '当前播放的音乐文件
Dim ID As Long '当前播放的声音文件ID
Dim SHU As Integer '当前路径下MID音乐文件总数
Dim SHUZU(200) As String 'MID音乐文件名数组
Private Sub Form_Load()
Dim A as Integer, path As String, APPPATH As String
Timer0.Enabled = False: Timer0.Interval = 1000
'获得当前路径8.3格式的短路径名
If Right(App.path, 1) = "\" Then path = App.path Else path = App.path & "\"
APPPATH = String$(165, 0)
A = GetShortPathName(path, APPPATH, 164)
APPPATH = Left(APPPATH, InStr(APPPATH, Chr(0)) - 1)
'取得当前路径下的MID文件个数并将文件名存入数组
SOUNDNAME = Dir(APPPATH)
Do While SOUNDNAME <> ""
If SOUNDNAME <> "." And SOUNDNAME <> ".." Then
If Right(SOUNDNAME, 3) = "MID" Or Right(SOUNDNAME, 3) = "mid" Or _
Right(SOUNDNAME, 3) = "RMI" Or Right(SOUNDNAME, 3) = "rmi" Then
SHU = SHU + 1
SHUZU(SHU) = APPPATH & SOUNDNAME
End If
End If
SOUNDNAME = Dir
Loop
Call yinyueSUB '程序启动后自动播放背景音乐
End Sub
Private Sub yinyueSUB()
Dim Res As Integer, Ret As String * 1024
Randomize (Timer)
SOUNDNAME = SHUZU(1 + Int(SHU * Rnd(1)))
Res = mciSendString("play " & SOUNDNAME, Ret, 1024, 0)
If Res <> 0 Then '如果播放不成功
背景音乐.Checked = False
Timer0.Enabled = False
Else
ID = mciGetDeviceID(SOUNDNAME) '获得ID
Timer0.Enabled = True
End If
End Sub
Private Sub Timer0_Timer()
'定时检测当前音乐是否播放完毕
If mciGetCreatorTask(ID) = 0 Then Call yinyueSUB
End Sub
Private Sub 背景音乐_Click()
Dim Ret As String * 1024, Res As Integer
If 背景音乐.Checked = True Then
背景音乐.Checked = False
Timer0.Enabled = False '停止计时
Res = mciSendString("pause " & SOUNDNAME, Ret, 1024, 0)
Else
背景音乐.Checked = True
Call yinyueSUB '去播放音乐子程序
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim Res As Integer, Ret As String * 1024
Res = mciSendString("close all", Ret, 1024, 0)
End
End Sub
全部回答
  • 1楼网友:轻熟杀无赦
  • 2021-01-28 21:09
单曲循环 mcisendstring "open test.mp3 alias mp3",vbnullstring,0&,0& mcisendstring "play mp3 repeat",vbnullstring,0&,0&
我要举报
如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
点此我要举报以上问答信息
大家都在看
推荐资讯