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