Ich werde mir das zu einem Späteren Zeitpunkt nochmal Anschauen. Ich habe jetzt etwas gefunden das genau das macht was es soll.
Code: Alles auswählen
EnableExplicit
;/
;/ Object Audio player 1.0 (a)
;/
;/ Date August 2004
;/ Author Philippe Carpentier
;/ Contact flype@altern.org
;/ Info MS Windows only - winmm.lib - mmsystem.h
;/
; Bug fixes by chris319 on September 2, 2007
; 04/02/2010 : DrGolf for PB 4.50
; 01/20/2011 : Vitor_Boss® -- Fixed clamping
; 6/8/2012 -- revised again by chris319 on PB 4.61
; 28/8/2022 : modified by morosh
; modified
;Structure WAVEFORMATEX -- NOT NEEDED IN PB 4.10 -- chris319
; wFormatTag.w
; nChannels.w
; nSamplesPerSec.l
; nAvgBytesPerSec.l
; nBlockAlign.w
; wBitsPerSample.w
; cbSize.w
;EndStructure
#MONO = 1
#STEREO = 2
#Button =0
Global QuitRec.l
Global lBuf.l, nBuf.l, nDev.l, fname.s, format.WAVEFORMATEX, hWindow.l, FileId.l
Global size.l, buffer.l, output.l, wave.l, played.l ,playing.b
Global Dim outHdr.WAVEHDR(16)
Declare PLAY_Stop()
Declare PLAY_Start()
Declare PLAY_GetDevices()
Declare PLAY_Write(hwaveOut.l,*hWave.WAVEHDR)
Declare FILE_Close()
Declare FILE_Open()
Declare FILE_wav2raw(fname.s)
Declare GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
Procedure.l getfiledatanum(nof.a, offset.u, len.a)
Protected tmpl.l=0, ch.a, i.a
FileSeek(nof,offset)
For i=1 To len
ReadData(nof, @ch, 1)
tmpl+ch*Pow(256,i-1)
Next
ProcedureReturn tmpl
EndProcedure
Procedure PLAY_Start()
Define i.a
format\wFormatTag = getfiledatanum(0,20,2)
format\nChannels = getfiledatanum(0,22,2)
format\nSamplesPerSec = getfiledatanum(0,24,4)
format\wBitsPerSample = getfiledatanum(0,34,2)
FileSeek(0,58)
PLAY_Stop()
format\nBlockAlign = (format\nChannels * format\wBitsPerSample) / 8
format\nAvgBytesPerSec = format\nSamplesPerSec * format\nBlockAlign
format\cbSize = 0
If waveOutOpen_(@wave,nDev,@format,hWindow,#Null,#CALLBACK_WINDOW|#WAVE_FORMAT_DIRECT) = #MMSYSERR_NOERROR
For i = 0 To nBuf - 1
outHdr(i)\lpData = AllocateMemory(lBuf)
outHdr(i)\dwBufferLength = lBuf
waveOutPrepareHeader_(wave,outHdr(i),SizeOf(WAVEHDR))
waveOutWrite_(wave,outHdr(i),SizeOf(WAVEHDR))
Next
If waveOutReset_(wave) <> #MMSYSERR_NOERROR
MessageRequester("Error","waveOutStart_(wave)",#MB_ICONERROR)
QuitRec=1
EndIf
Else
MessageRequester("Error","waveOutOpen_ failed",#MB_ICONERROR)
QuitRec=1
EndIf
EndProcedure
;
Procedure PLAY_Stop()
Define i.a
If wave
waveOutReset_(wave)
; waveOutStop_(wave)
For i = 0 To nBuf - 1
If outHdr(i)
waveOutUnprepareHeader_(wave,outHdr(i),SizeOf(WAVEHDR))
EndIf
Next
waveOutClose_(wave)
EndIf
EndProcedure
;
Procedure PLAY_Write(hwaveOut.l,*hWave.WAVEHDR)
; Define *hWave.WAVEHDR
;*hWave=lpWaveHdr
buffer=*hWave\lpData
size=*hWave\dwBufferLength
If playing = #True
ReadData(0, buffer,size)
played + size
EndIf
waveOutWrite_(hwaveOut,*hWave,SizeOf(WAVEHDR))
;Beep_(100,100)
EndProcedure
;
Procedure PLAY_GetDevices()
Define MMNumDevice.l, MMDeviceId.l, MMResult.l, Caps.waveOutCAPS
MMNumDevice = waveOutGetNumDevs_()
If MMNumDevice
For MMDeviceId=#WAVE_MAPPER To MMNumDevice-1
MMResult.l = waveOutGetDevCaps_(MMDeviceId,@Caps,SizeOf(waveOutCAPS))
If MMResult = #MMSYSERR_NOERROR
Debug Str(MMDeviceId) + " " + PeekS(@Caps\szPname,#MAXPNAMELEN)
; AddGadgetItem(gadId,-1,PeekS(@Caps\szPname,#MAXPNAMELEN))
EndIf
Next
EndIf
EndProcedure
Procedure FILE_Open()
If playing = #False
FILE_wav2raw(fname)
EndIf
played = #Null ; -- MOVED HERE BY chris319
FileId=ReadFile(0,fname)
If FileId
playing=#True
Else
MessageRequester("Error","Can't Read file",#MB_ICONERROR)
EndIf
EndProcedure
Procedure FILE_Close()
If playing
playing = #False
CloseFile(0)
Delay(1000)
EndIf
EndProcedure
Procedure FILE_wav2raw(fname.s)
Define inId.l, outId.l, pBuf.l, subchunk2size.l, chunksize.l, f$, x$, b.w, c.w, h.l
inId = ReadFile(#PB_Any,fname)
If inId = #Null
MessageRequester("Error", "Unable to open file",#MB_ICONERROR) ; chris319
ProcedureReturn #False
EndIf
lBuf.l = Lof(inId)
If lBuf = #Null
MessageRequester("Error", "lbuf=0",#MB_ICONERROR) ; chris319
ProcedureReturn #False
EndIf
pBuf = AllocateMemory(lBuf)
If pBuf = #Null
MessageRequester("Error", "Unable to allocate buffer",#MB_ICONERROR) ; chris319
ProcedureReturn #False
EndIf
ReadData(inId, pBuf,lBuf)
CloseFile(inId)
f$ = GetFilePart(fname)
x$ = GetPathPart(fname)+Left(f$,Len(f$)-Len(GetExtensionPart(fname))-1)+".raw"
outId = CreateFile(#PB_Any,x$)
If outId = #Null
MessageRequester("Error", "Unable to create file",#MB_ICONERROR) ; chris319
ProcedureReturn #False
EndIf
WriteData(outId, pBuf+58,lBuf-58)
CloseFile(outId)
FreeMemory(pBuf) ;chris319
ProcedureReturn #True
EndProcedure
;
Procedure GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
Define Result.l
Result = #PB_ProcessPureBasicEvents
Select Msg
Case #WM_KEYDOWN
If GetAsyncKeyState_(#VK_ESCAPE)
QuitRec = 1
EndIf
Case #MM_WOM_DONE
PLAY_Write(wParam,lParam)
Case #WM_COMMAND
Select wParam & $FFFF
Case #Button
FILE_Open() : PLAY_Start()
Case #Button+1
FILE_Close() : QuitRec=1
EndSelect
EndSelect
ProcedureReturn Result
EndProcedure
;
;- REC MAIN
;;;;;;;;;;;;;;;;;;;;;;;;;;;GUI_init ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
QuitRec = 0
fname = "Z:\PB_Projecte\AudioOut\explosionen.wav"
nDev = 0
nBuf = 8
lBuf = 2048
hWindow=OpenWindow(0,0,0,500,400,"Player",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
LoadFont(0, "Arial", 12)
ButtonGadget(#Button, 50,50,100,20,"Replay")
ButtonGadget(#Button+1, 200,50,100,20,"Stop")
SetGadgetFont(#Button, FontID(0))
SetGadgetFont(#Button+1, FontID(0))
PLAY_GetDevices()
SetWindowCallback(@GUI_CallBack())
playing = #False
FILE_Open()
PLAY_Start()
Repeat
Until WaitWindowEvent() = #WM_CLOSE Or QuitRec
PLAY_Stop()
CloseDebugOutput()
; Devices
;-1 Microsoft Sound Mapper
;0 Speakers (Realtek High Definiti
;1 Realtek Digital Output (Realtek
;2 Speakers (Bluetooth AV Audio)
;3 Speakers (Bluetooth SCO Audio)