返回列表 上一主題 發帖

[發問] WindowsMediaPlayer播放音檔問題

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
1# 跳轉到 »
發表於 2016-1-20 19:02 | 顯示全部帖子
回復 1# lshsien
正如 Joforn 大大所提示的，以下的
代碼不需要 MediaPlayer 的支援控件。
如果你較習慣使用 MediaPlayer 控件
那麼你便可以不用往下閱覽了。
  1. Option Explicit

  3. Private Const SND_APPLICATION = &H80         '  look for application specific association
  4. Private Const SND_ALIAS = &H10000            '  name is a WIN.INI [sounds] entry
  5. Private Const SND_ALIAS_ID = &H110000        '  name is a WIN.INI [sounds] entry identifier
  6. Private Const SND_ASYNC = &H1                '  play asynchronously
  7. Private Const SND_FILENAME = &H20000         '  name is a file name
  8. Private Const SND_LOOP = &H8                 '  loop the sound until next sndPlaySound
  9. Private Const SND_MEMORY = &H4               '  lpszSoundName points to a memory file
  10. Private Const SND_NODEFAULT = &H2            '  silence not default, if sound not found
  11. Private Const SND_NOSTOP = &H10              '  don't stop any currently playing sound
  12. Private Const SND_NOWAIT = &H2000            '  don't wait if the driver is busy
  13. Private Const SND_PURGE = &H40               '  purge non-static events for task
  14. Private Const SND_RESOURCE = &H40004         '  name is a resource name or atom
  15. Private Const SND_SYNC = &H0                 '  play synchronously (default)

  17. #If VBA7 Then
  18.     Private Declare PtrSafe Function PlaySoundA Lib "winmm.dll" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  19.     '  以上係 .Wav 檔之參數宣告； 下列三行為 .MP3 檔案宣告之引用功能函式及變數宣告。
  20.     Private Declare PtrSafe 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
  21.     Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  22. #Else
  23.     Private Declare Function PlaySoundA Lib "winmm.dll" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  24.     '  以上係 .Wav 檔之參數宣告； 下列三行為 .MP3 檔案宣告之引用功能函式及變數宣告。
  25.     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
  26.     Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  27. #End If

  29. Dim Mp3File, LastMp3File As String, lst() As String, idx As Long

  31. Sub Ex()
  32.     Dim cnt As Long
  33.    
  34.     idx = 0
  35.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_各位旅客您好.wav")
  36.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_6點.wav")
  37.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分50.wav")
  38.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分.wav")
  39.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_開往.wav")
  40.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_台北的.wav")
  41.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次5.wav")
  42.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0.wav")
  43.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0.wav")
  44.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_次.wav")
  45.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_高鐵.wav")
  46.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_北上.wav")
  47.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_的列車即將進站請前往.wav")
  48.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_第二月台.wav")
  49.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_搭乘並留意月台間隙謝謝.wav")
  50.         
  51.     For cnt = 1 To UBound(lst)
  52.         If UCase(Right(lst(cnt), 4)) = ".WAV" Then
  53.             PlaySound (lst(cnt))
  54.         ElseIf UCase(Right(lst(cnt), 4)) = ".MP3" Then
  55.             MMStop (LastMp3File)
  56.             LastMp3File = lst(cnt)
  57.             MMPlay (lst(cnt))
  58.         End If
  59.     Next cnt
  60.         
  61.     rmvList
  62. End Sub

  64. Public Function addList(ByVal fn As String)
  65.     Dim num As Long
  66.    
  67.     If idx = 0 Then num = 1 Else num = UBound(lst) + 1
  68.     ReDim Preserve lst(num)
  69.     lst(num) = fn
  70.     idx = idx + 1
  71. End Function

  73. Public Function rmvList()
  74.     If idx = 0 Then Exit Function
  75.     ReDim Preserve lst(0)   '  lst :  String(0 to 0)
  76.     idx = 0                 '  UBound(lst) = 0 : Long
  77. End Function

  79. ' Purpose     :  Plays an audio file
  80. ' Inputs      :  sFilePath           The location of the wav file
  81. '                lFlags              Can be one or many of the constants given above
  82. ' Outputs     :  The text found on the web site
  83. ' Author      :  Andrew Baker
  84. ' Date        :  21/10/2000 12:37
  85. ' Notes       :  Code adapted from code found on www.allapi.net (excellent site!)
  86. ' Revisions   :

  88. Function PlaySound(sFilePath As String, Optional lFlags As Long = SND_FILENAME Or SND_ASYNC) As Long
  89.     PlaySound = PlaySoundA(sFilePath, 0&, lFlags)
  90. End Function

  92. Function ConvShortFilename(ByVal strLongPath$) As String
  93.     Dim strShortPath$
  94.     If InStr(1, strLongPath, " ") Then
  95.         strShortPath = String(LenB(strLongPath), Chr(0))
  96.         GetShortPathName strLongPath, strShortPath, Len(strShortPath)
  97.         ConvShortFilename = Left(strShortPath, InStr(1, strShortPath, Chr(0)) - 1)
  98.     Else
  99.         ConvShortFilename = strLongPath
  100.     End If
  101. End Function

  103. Private Sub MMPlay(ByRef FileName As String)
  104.     FileName = ConvShortFilename(FileName)
  105.     mciSendString "close " & FileName, vbNullString, 0, 0
  106.     mciSendString "open " & FileName, vbNullString, 0, 0
  107.     mciSendString "play " & FileName, vbNullString, 0, 0
  108. End Sub

  110. Private Sub MMStop(ByRef FileName As String)
  111.     FileName = ConvShortFilename(FileName)
  112.     mciSendString "stop " & FileName, vbNullString, 0, 0
  113.     mciSendString "close " & FileName, vbNullString, 0, 0
  114. End Sub
複製代碼
1

評分人數

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2016-1-22 18:48 | 顯示全部帖子
回復 6# lshsien
雖然你偏好使用 Windows Media Player，
但我使用 Joforn 大大提供的程式碼測試
三種型態的媒體檔 (*.mp3;*.wav;*.mp4)
它在執行撥放過程非常穩定，DoEvents 的
時段拿捏得恰當，尤其是 mp4 影片撥放
視窗也很流暢，蠻值得你採用。其實
Windows Media Player元件亦使用同樣之
Windows System 程式庫 (Lib)。
  1. Sub Ex()
  2.     ItemAdd (ThisWorkbook.Path & "\" & "大悲咒天使波羅蜜.wav")
  3.     ItemAdd (ThisWorkbook.Path & "\" & "舒伯特 小夜曲 大提琴演奏 .mp4")
  4.     ItemAdd (ThisWorkbook.Path & "\" & "寶篋咒.mp3")
  5.     ItemAdd (ThisWorkbook.Path & "\" & "聖誕快樂 01.mp4")
  6.     ItemAdd (ThisWorkbook.Path & "\" & "01_巴哈 G弦之歌 Air On the G string.mp3")
  7.     ItemAdd (ThisWorkbook.Path & "\" & "舒伯特 小夜曲 大提琴演奏 .mp4")
  8.     ItemAdd (ThisWorkbook.Path & "\" & "02_NOCTURNE.mp3")
  9.     ItemAdd (ThisWorkbook.Path & "\" & "03_SAULT D' AMOUR.mp3")
  10.     ItemAdd (ThisWorkbook.Path & "\" & "04_JUNE(BARCAROLLE).mp3")
  11.    
  12.     StartPlay
  13. End Sub
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
3#
發表於 2016-1-23 14:33 | 顯示全部帖子
回復 10# Joforn
回復 9# ML089
Pause  以及 Resume 的處理，我寫了一
函式，如下：
  1. Public Sub PauseResume()
  2.     Static Msg As Boolean    '  用以判定是否為每日第一次執行
  3.    
  4.     If Msg = False Then
  5.         mciSendString StrPtr("pause JofornMusic"), 0&, 0, 0
  6.         Msg = True
  7.     Else
  8.         mciSendString StrPtr("resume JofornMusic"), 0&, 0, 0
  9.         Msg = False
  10.     End If
  11. End Sub
複製代碼
另外，再請教 Joforn 大大，如果想要執行 *.rmvb 的媒體檔，
還要加掛那些 Lib，才能夠執行？
謝謝你！

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
4#
發表於 2016-1-24 20:38 | 顯示全部帖子
本帖最後由 c_c_lai 於 2016-1-24 20:42 編輯

回復 1# lshsien
我特選了九首音樂 (樂曲長短不一，含MP4檔)，反覆測試
均能正常撥放。你試試看吧！
  1. Option Explicit

  3. Dim Xwmp As IWMPMedia                       '  Playlist
  4. Dim MyPlayer As WindowsMediaPlayer
  5. Dim ListIdx As Long

  7. Public Function addList(ByVal fileName As String)
  8.     Set Xwmp = MyPlayer.newMedia(fileName)
  9.     MyPlayer.currentPlaylist.insertItem ListIdx, Xwmp
  10.     ListIdx = ListIdx + 1
  11.     DoEvents
  12.     MyPlayer.Controls.Play
  13. End Function

  15. Public Function rmvList()
  16.     DoEvents
  17.     If MyPlayer.playState = 1 Or MyPlayer.playState = 10 Then      '  "Stopped"  or  "Ready"
  18.         ListIdx = 0
  19.         MyPlayer.currentPlaylist.Clear
  20.     End If
  21. End Function

  23. Sub Ex()
  24.     Set MyPlayer = 工作表1.WindowsMediaPlayer1
  25.     rmvList
  26.    
  27.     addList ThisWorkbook.Path & "\\" & "大悲咒天使波羅蜜.wav"
  28.     addList ThisWorkbook.Path & "\\" & "寶篋咒.mp3"
  29.     addList ThisWorkbook.Path & "\\" & "舒伯特 小夜曲 大提琴演奏 .mp4"
  30.     addList ThisWorkbook.Path & "\\" & "聖誕快樂 01.mp4"
  31.     addList ThisWorkbook.Path & "\\" & "01_巴哈 G弦之歌 Air On the G string.mp3"
  32.     addList ThisWorkbook.Path & "\\" & "鐵達尼號 - My Heart Will Go On (我心永恆) 中英文字幕.mp4"
  33.     addList ThisWorkbook.Path & "\\" & "02_NOCTURNE.mp3"
  34.     addList ThisWorkbook.Path & "\\" & "03_SAULT D' AMOUR.mp3"
  35.     addList ThisWorkbook.Path & "\\" & "- Barcarolle in F sharp, Op.60.mp3"
  36. End Sub
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
5#
發表於 2016-1-25 12:57 | 顯示全部帖子
回復 1# lshsien
基本上，Windows Media Player 是無法撥放  *.rmvb 檔，
如果你想透過 Windows Media Player 的撥放器來撥放
*.rmvb 的影片檔，其實務應用範例如下，提供大家參考：
  1. Option Explicit

  3. Dim MyPlayer As WindowsMediaPlayer

  5. Public Function playRMVB(ByVal fileName As String)
  6.     MyPlayer.URL = fileName        '  需以 .URL 方式宣告
  7.     DoEvents
  8.     MyPlayer.Controls.Play
  9. End Function

  11. Public Function InitialList()
  12.     MyPlayer.Controls.stop
  13.    
  14.     DoEvents
  15.     If MyPlayer.playState = 0 Or MyPlayer.playState = 1 Or MyPlayer.playState = 10 Then
  16.         '  0 = "Undefined"  /  1 = "Stopped"  /  10 = "Ready"
  17.         ListIdx = 0
  18.         MyPlayer.currentPlaylist.Clear
  19.     End If
  20. End Function

  22. Sub Ex()
  23.     Set MyPlayer = 工作表1.WindowsMediaPlayer1
  24.     InitialList
  25.    
  26.     '  ******************************************************************
  27.     '  撥放 RMVB 影片檔需先安裝 Real_Alternative 的解析碼後， Windows
  28.     '  Media Player 才能進行解析 RMVB 影片檔，進而始能直接撥放它。
  29.     '  http://www.free-codecs.com/real_alternative_download.htm
  30.     '  以下三行係 .rmvb 影片之撥放程序  (*** 但只能放置在第一首撥放 ***)
  31.     '  1. MyPlayer.URL = ThisWorkbook.Path & "\\" & "xxxxxxxx.rmvb"
  32.     '  2. DoEvents
  33.     '  3. MyPlayer.Controls.Play
  34.     '  ******************************************************************
  35.     playRMVB ThisWorkbook.Path & "\\" & "xxxxxxxx.rmvb"
  36. End Sub
複製代碼

TOP

        靜思自在 : 吃苦了苦、苦盡廿來，享福了福、福盡悲來。
返回列表 上一主題