waveファイルの再生 - abwiki @ ウィキ (ActiveBasic非公式wiki)

#include <api_mmsys.sbp>
Declare Function waveOutOpen Lib "winmm" (phwo As *HWAVEOUT, uDeviceID As DWord, pwfx As *WAVEFORMATEX, dwCallback As DWord, dwInstance As DWord, fdwOpen As DWord) As MMRESULT
Declare Function waveOutClose Lib "winmm" (hwo As HWAVEOUT) As MMRESULT
Declare Function waveOutPrepareHeader Lib "winmm" (hwo As HWAVEOUT, pwh As *WAVEHDR, cbwh As DWord) As MMRESULT
Declare Function waveOutUnprepareHeader Lib "winmm" (hwo As HWAVEOUT, pwh As *WAVEHDR, cbwh As DWord) As MMRESULT
Declare Function waveOutWrite Lib "winmm" (hwo As HWAVEOUT, pwh As *WAVEHDR, cbwh As DWord) As MMRESULT
Declare Function waveOutPause Lib "winmm" (hwo As HWAVEOUT) As MMRESULT
Declare Function waveOutRestart Lib "winmm" (hwo As HWAVEOUT) As MMRESULT
Declare Function waveOutReset Lib "winmm" (hwo As HWAVEOUT) As MMRESULT
Declare Function waveOutGetPosition Lib "winmm" (hwo As HWAVEOUT, pmmt As *MMTIME, cbmmt As DWord) As MMRESULT
Declare Function MulDiv Lib "kernel32" (nNumber As Long, nNumerator As Long, nDenominator As Long) As Long

Const WAVE_MAPPER = (-1)
Const CALLBACK_FUNCTION = &H00030000l
Const WOM_OPEN = &H3BB
Const WOM_CLOSE = &H3BC
Const WOM_DONE = &H3BD
Const WHDR_DONE = &H00000001
Const WHDR_PREPARED = &H00000002
Const WHDR_BEGINLOOP = &H00000004
Const WHDR_ENDLOOP = &H00000008
Const WHDR_INQUEUE = &H00000010

Const TIME_MS = &H0001
Const TIME_SAMPLES = &H0002
Const TIME_BYTES = &H0004
Const TIME_SMPTE = &H0008
Const TIME_MIDI = &H0010
Const TIME_TICKS = &H0020

TypeDef MMRESULT = DWord
Typedef HWAVEOUT = VoidPtr
Type WAVEHDR
lpData As *Byte
dwBufferLength As DWord
dwBytesRecorded As DWord
dwUser As DWord
dwFlags As DWord
dwLoops As DWord
lpNext As *WAVEHDR
reserved As *DWord
End Type
Type MMTIME
wType As DWord
u As DWord
u2 As DWord
End Type

Class WavePlayer
Private
buffer[2] As *Byte
hwo As HWAVEOUT
wfe As WAVEFORMATEX
hF As HANDLE
switch As Long

Function GetWavHeader() As Long
Dim head[3] As Byte
Dim r As DWord
ReadFile(hF, head, 4, VarPtr(r), ByVal 0)
If (memcmp(head, "RIFF", 4)) Then Exit Function
ReadFile(hF, head, 4, VarPtr(r), ByVal 0)'ファイルサイズ
ReadFile(hF, head, 4, VarPtr(r), ByVal 0)
If (memcmp(head, "WAVE", 4)) Then Exit Function
ReadFile(hF, head, 4, VarPtr(r), ByVal 0)
If (memcmp(head, "fmt ", 4)) Then Exit Function
ReadFile(hF, head, 4, VarPtr(r), ByVal 0)
ReadFile(hF, VarPtr(wfe), Sizeof(WAVEFORMATEX), VarPtr(r), ByVal 0)
If r <> SizeOf(WAVEFORMATEX) Then Exit Function
ReadFile(hF, head, 2, VarPtr(r), ByVal 0)'"ta"
ReadFile(hF, head, 4, VarPtr(r), ByVal 0)'データサイズ
GetWavHeader = 1
End Function

Sub waveOutProc(hwo As HWAVEOUT, uMsg As DWord, dwInstance As *DWord, dwParam1 As DWord, dwParam2 As DWord)
Dim x As *WavePlayer
x = dwInstance
Select Case uMsg
Case WOM_CLOSE
Case WOM_DONE
x->wh[1].dwUser = x->wh[1].dwUser - 1
If x->wh[0].dwUser = 0 Then x->read(hwo)
Case WOM_OPEN
End Select
End Sub

Public
wh[2] As WAVEHDR
Sub read(hwo As HWAVEOUT)
Dim r As DWord

If hwo = NULL Or wh[0].dwUser = 1 Or wh[1].dwUser > 1 Then Exit Sub
waveOutUnprepareHeader(hwo, VarPtr(wh[switch]), SizeOf(WAVEHDR))
ReadFile(hF, buffer[switch], wfe.nAvgBytesPerSec, VarPtr(r), ByVal 0)
wh[switch].lpData = buffer[switch]
wh[switch].dwBufferLength = r
If r = 0 Then wh[0].dwUser = 1'これ以上再生しません
waveOutPrepareHeader(hwo, VarPtr(wh[switch]), SizeOf(WAVEHDR))
waveOutWrite(hwo, VarPtr(wh[switch]), SizeOf(WAVEHDR))
wh[1].dwUser = wh[1].dwUser + 1
switch = switch + 1
If switch = 2 Then switch = 0
End Sub

Function play(infile As *Byte) As Long
If hwo <> NULL Then Exit Function
hF = CreateFile(infile, GENERIC_READ, 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If hF = INVALID_HANDLE_VALUE Then Exit Function
If GetWavHeader() = 0 Then
CloseHandle(hF)
Exit Function
End If
buffer[0] = malloc(wfe.nAvgBytesPerSec)
buffer[1] = malloc(wfe.nAvgBytesPerSec)
waveOutOpen( VarPtr(hwo), WAVE_MAPPER, VarPtr(wfe), AddressOf(waveOutProc) ,VarPtr(this), CALLBACK_FUNCTION)
read(hwo)
Sleep(500)
read(hwo)
play = 1
End Function

Sub stop() As Long
If hwo = NULL Then Exit Sub
wh[0].dwUser = 1
waveOutReset(hwo)
While wh[1].dwUser > 0
Sleep(1)
Wend
waveOutUnprepareHeader(hwo, VarPtr(wh[0]), SizeOf(WAVEHDR))
waveOutUnprepareHeader(hwo, VarPtr(wh[0]), SizeOf(WAVEHDR))
free(buffer[0])
free(buffer[1])

waveOutClose(hwo)
CloseHandle(hF)
hwo = NULL
End Sub

Function state(t As *DWord) As Long
state = wh[1].dwUser
If t = NULL Then Exit Function
Dim mmt As MMTIME
mmt.wType = TIME_SAMPLES
waveOutGetPosition(hwo, VarPtr(mmt), SizeOf(MMTIME))
SetDWord(t,MulDiv(mmt.u , 1000, wfe.nSamplesPerSec))
End Function
End Class

#define SELFTEST
#ifdef SELFTEST
#N88BASIC
Dim wp As WavePlayer
Dim time As DWord
Print "再生"
wp.play("test.wav")
While wp.state(VarPtr(time))
Locate 4,1
Print time\1000;"sec"
Sleep(1000)
Wend
wp.stop()
Print "停止"
#endif