Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Private Declare Function waveOutOpen Lib "winmm.dll" (lphWaveOut As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As Any, ByVal uSize As Long) As Long
Private Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long
Private Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As Any, ByVal uSize As Long) As Long
Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As Any, ByVal uSize As Long) As Long
Private Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, pch As Any, ByVal cch As Long) As Long
Private Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long
Private Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As Any, ByVal dwOpenFlags As Long) As Long
Private Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal uFlags As Long) As Long
Private Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, lpckParent As Any, ByVal uFlags As Long) As Long
Private Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal dwBytes As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Const WAVE_MAPPER = -1&
Private Const WAVE_FORMAT_PCM = 1
Private Const TIME_MS = &H1
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_SHARE = &H2000
Private Const CALLBACK_WINDOW = &H10000
Private Const MMIO_READ = &H0
Private Const MMIO_FINDCHUNK = &H10
Private Const MMIO_FINDRIFF = &H20
Private hWave As Long
Private hmmio As Long
Private mmParent As MMCKINFO
Private mmSub As MMCKINFO
Private hWHdr As Long
Private lpWHdr As Long
Private hData As Long
Private lpData As Long
Private tsec, csec As Double
Private Sub WaveClose()
Dim r As Long
r = GlobalUnlock(hData)
r = GlobalFree(hData)
r = waveOutUnprepareHeader(hWave, ByVal lpWHdr, Len(whdr))
r = GlobalUnlock(hWHdr)
r = GlobalFree(hWHdr)
r = waveOutReset(hWave)
r = waveOutClose(hWave)
End Sub
Private Sub WavePlay(FileName As String)
Dim r As Long
Dim s As String
Dim FmtSize As Long
Dim DataSize As Long
Dim ErrMsg As String * 256
Dim chan As String
Dim sample As Double
Dim bits As Double
Dim sec As Double
'ﾌｧｲﾙを開く
hmmio = mmioOpen(FileName, ByVal 0&, MMIO_READ)
If hmmio = 0& Then
ErrMsg = "ﾌｧｲﾙを開くことができません"
MsgBox ErrMsg
r = mmioClose(hmmio, 0)
End If
'WAVﾌｧｲﾙであることを確認する
mmParent.fccType = mmioStringToFOURCC("WAVE", 0)
r = mmioDescend(hmmio, mmParent, ByVal 0&, MMIO_FINDRIFF)
If r <> 0 Then
ErrMsg = "WAVﾌｧｲﾙではありません"
MsgBox ErrMsg
r = mmioClose(hmmio, 0)
Exit Sub
End If
'fmtﾁｬﾝｸを検索
mmSub.ckid = mmioStringToFOURCC("fmt ", 0)
r = mmioDescend(hmmio, mmSub, mmParent, MMIO_FINDCHUNK)
If r <> 0 Then
ErrMsg = "WAVﾌｧｲﾙにfmtﾁｬﾝｸがありません"
MsgBox ErrMsg
r = mmioClose(hmmio, 0)
Exit Sub
End If
'fmtﾁｬﾝｸのサイズを取得
FmtSize = mmSub.ckSize
'fmtﾁｬﾝｸの読み取り
s = String(Len(pwfmt), 0)
r = mmioRead(hmmio, ByVal s, FmtSize)
CopyMemory pwfmt, ByVal s, FmtSize
If r <> FmtSize Then
ErrMsg = "fmtﾁｬﾝｸの読取りに失敗しました"
MsgBox ErrMsg
r = mmioClose(hmmio, 0)
Exit Sub
End If
'fmtﾁｬﾝｸから退出
r = mmioAscend(hmmio, mmSub, 0)
'dataﾁｬﾝｸを検索
mmSub.ckid = mmioStringToFOURCC("data", 0)
r = mmioDescend(hmmio, mmSub, mmParent, MMIO_FINDCHUNK)
If r <> 0 Then
ErrMsg = "WAVﾌｧｲﾙにdataﾁｬﾝｸがありません"
MsgBox ErrMsg
r = mmioClose(hmmio, 0)
Exit Sub
End If
'dataﾁｬﾝｸのサイズを取得
DataSize = mmSub.ckSize
If DataSize = 0 Then
ErrMsg = "dataﾁｬﾝｸにdataが格納されていません"
MsgBox ErrMsg
r = mmioClose(hmmio, 0)
Exit Sub
End If
'ﾃﾞｰﾀのﾒﾓﾘを割り当てﾛｯｸする
hData = GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE, DataSize)
