ich möchte ein wenig mit dem Mikrofon rumspielen und habe einen entsprechenden Code gefunden, welcher aber schon sehr alt war und nicht mehr lief. Ich habe ihn auf PB5.3 aktualisiert:
Code: Alles auswählen
; English forum: http://www.purebasic.fr/english/viewtopic.php?t=7009&highlight=
; Author: Flype (updated for PB3.93 by Andre, updated for PB4.00 by blbltheworm)
; Date: 27. July 2003
; OS: Windows
; Demo: No
; Updated by Chimorin (Bananenfreak) to PB5.30
; Date: 3. October 2014
; Here is a program (by me) that shows how to capture audio under windows without using
; MCI functions. Raw sound is saved in a file... which can be loaded and listened thanx
; a software like SoundForge.
; Raw format sound generated : 16bit, Mono, 44100Hz
; You have to configure the Volume Control (use the volume systray icon) in order to select
; Stereo Mixer (Menu->Properties->Record...). You should also set the volume not too high...
EnableExplicit
;***********************************************************************************
;- DECLARATIONS ; SOUND CAPTURE, Flype (26-juil-2002)
;***********************************************************************************
Declare CAPTURE_Read(hWaveIn.i, lpWaveHdr.i)
Declare CAPTURE_Error(err.l)
Declare CAPTURE_Start()
Declare CAPTURE_Stop()
Declare CAPTURE_Draw()
Declare CAPTURE_Now()
Declare GUI_CallBack(hWnd.i, Message.i, wParam.i, lParam.i)
Declare GUI_Button( id.l, ico.l, tip.s )
Declare GUI_Init()
Declare GUI_Main()
Declare GUI_Resize()
Declare FILE_Recording( state.b )
Declare FILE_Create()
Declare FILE_Append()
Declare FILE_Close()
;***********************************************************************************
;- INIT CONFIGURABLE CONSTANTES
;***********************************************************************************
#SOUND_NCHANNELS = 1 ; This example only support Mono
#SOUND_NBITS = 16 ; This example only support 16bits
#SOUND_NHERTZ = 44100 ; Try 8000, 11050, 22100, 44100...
#BUFFER_NUM = 8 ; Number of buffer for capture
#BUFFER_SIZE = 512 ; Size of each buffer, should be x2 in Stereo
#BUFFER_TICK = 10 ; Wave redraw delay : SetTimer_ in CAPTURE_Start()
;***********************************************************************************
;- INIT CONSTANTES
;***********************************************************************************
#winMain=0
#gadRecord = 0
#gadStop = 1
#gadMode = 2
#StatusBar = 0
#StatusTime = 0
#StatusInfo = 1
#StatusFile = 2
#COLOR_RECBACK = $000050
#COLOR_RECLINE = $000035
#COLOR_RECWAVE = $1010E0
#COLOR_CAPBACK = $004900
#COLOR_CAPLINE = $004000
#COLOR_CAPWAVE = $20E020
#COLOR_VOLUME = $00FFFF
#STR_ERROR = "Error"
#STR_STOP = "Stop"
#STR_RECORD = "Record"
#STR_CLOSED = "File saved"
#STR_SAVEREQ = "Choose a file..."
#STR_MODE = "Display mode"
#STR_RECORDED = " bytes recorded"
#STR_PBFILE = "Problem while creating file"
#STR_NODEVICE = "Audio device not found"
;***********************************************************************************
;- INIT STRUCTURES
;***********************************************************************************
Structure RECORD_INFO
x.l ; Left
y.l ; Top
w.l ; Width
h.l ; Height
m.l ; YMiddle
cback.l ; Back color
cline.l ; Line color
cwave.l ; Wave color
size.l ; Wave buffer size
buffer.l ; Wave buffer pointer
output.l ; WindowOutput()
mode.b ; Wave mode (line or plain)
wave.l ; Address of waveform-audio input device
frame.b ; Counter for back clearing
update.b ; If true Wave have to be redrawn
recorded.l ; Number of bytes recorded
recording.b ; Record is running...
time.s ; Store the time string
EndStructure
; Structure WAVEFORMATEX
; wFormatTag.w
; nChannels.w
; nSamplesPerSec.l
; nAvgBytesPerSec.l
; nBlockAlign.w
; wBitsPerSample.w
; cbSize.w
; EndStructure
Global Dim inHdr.WAVEHDR( #BUFFER_NUM )
Global inHdr, rec.RECORD_INFO, now.SYSTEMTIME
Global.i file
rec\time = Space(9)
;***********************************************************************************
;- PROCS CAPTURE
;***********************************************************************************
Procedure CAPTURE_Error( err.l )
Protected.s text
If err
text = Space(#MAXERRORLENGTH)
waveInGetErrorText_(err, text, #MAXERRORLENGTH) ;Diese Funktion ruft eine Textbeschreibung des von der angegebenen Fehlernummer identifiziert Fehler.
MessageRequester(#STR_ERROR, text, #MB_ICONERROR)
CAPTURE_Stop()
End
EndIf
EndProcedure
;==============================================================================
Procedure CAPTURE_Now()
GetLocalTime_( @now )
GetTimeFormat_(0, 0, @now, "HH:mm:ss:", @rec\time, 9 )
StatusBarText( #StatusBar, #StatusTime, rec\time+Str(now\wMilliseconds) )
EndProcedure
;==============================================================================
Procedure CAPTURE_Draw()
Protected.i shift, oldx, oldy, i, value, x, y, max
If rec\update = #True
CAPTURE_Now()
StartDrawing(CanvasOutput(rec\output))
; Draw Background...
If rec\frame = 2
Box( rec\x, rec\y, rec\w, rec\h, rec\cback)
shift = rec\h >> 2
Line(rec\x, rec\m - shift, rec\w, 0, rec\cline)
Line(rec\x, rec\m + shift, rec\w, 0, rec\cline)
rec\frame = 0
Else
rec\frame + 1
EndIf
;Draw Wave Data
oldx = rec\x
oldy = 0
For i=0 To rec\size Step #PB_Word
value = PeekW(rec\buffer + i)
x = rec\x + (i * rec\w-1) / rec\size
y = (value * rec\h) / $FFFF
If value > max
max = value
EndIf
If x <> oldx
Select rec\mode
Case #True
LineXY(oldx, rec\m+oldy, x, rec\m+y, rec\cwave)
Case #False
LineXY(oldx, rec\m+oldy, x, rec\m-y, rec\cwave)
EndSelect
oldx=x
oldy=y
EndIf
Next
; Draw Volume
Box(rec\x+1, rec\h+rec\y-5, (max*(rec\w-2))/$7FFF, 2, #COLOR_VOLUME)
StopDrawing()
rec\update = #False
EndIf
EndProcedure
;==============================================================================
Procedure.s CAPTURE_GetDevice() ;
Protected.WAVEINCAPS caps
Protected.i i
For i=0 To waveInGetNumDevs_()-1 ;Die waveInGetNumDevs Funktion gibt die Anzahl der Wellenform-Audio-Eingang im System vorhandenen Geräte.
CAPTURE_Error(waveInGetDevCaps_( i, @caps, SizeOf( WAVEINCAPS ))) ;Die waveInGetDevCaps Funktion ruft die Fähigkeiten eines gegebenen Wellenform-Audioeingabegerät.
Debug Bin(caps\dwFormats)
Debug Bin(#WAVE_FORMAT_1S08)
If caps\dwFormats & #WAVE_FORMAT_1S08 ;-OOOO Wat solln das hier?
ProcedureReturn PeekS(@caps\szPname)
EndIf
Next
ProcedureReturn #STR_NODEVICE
EndProcedure
;==============================================================================
Procedure CAPTURE_Start() ;Initialisierungszeug.
Protected.WAVEFORMATEX format
Protected.s deviceName
Protected.i i
deviceName = CAPTURE_GetDevice()
If deviceName
SetWindowText_( WindowID(#winMain), DeviceName )
format\wFormatTag = 1
format\nChannels = #SOUND_NCHANNELS
format\wBitsPerSample = #SOUND_NBITS
format\nSamplesPerSec = #SOUND_NHERTZ
format\nBlockAlign = #SOUND_NCHANNELS * (#SOUND_NBITS/8)
format\nAvgBytesPerSec = #SOUND_NHERTZ * format\nBlockAlign
format\cbSize = 0
CAPTURE_Error(waveInOpen_(@rec\wave, #WAVE_MAPPER, @format, WindowID(0), #Null, #CALLBACK_WINDOW|#WAVE_FORMAT_DIRECT)) ;Öffnet das spezifische Waveinputdevice.
For i = 0 To #BUFFER_NUM - 1
inHdr(i)\lpData = AllocateMemory(#BUFFER_SIZE )
inHdr(i)\dwBufferLength = #BUFFER_SIZE
CAPTURE_Error(waveInPrepareHeader_(rec\wave, inHdr(i), SizeOf(WAVEHDR))) ;Diese Funktion erstellt einen Puffer für Eingangswellenform. Diese Funktion ermöglicht dem Audiotreiber und dem Betriebssystem (OS) zu Zeit raubende Verarbeitung des Kopf-und / oder Puffer einmal bei der Initialisierung. Die Anwendung kann die Puffer wiederholt ohne zusätzliche Verarbeitungs Nutzung durch den Fahrer oder das Betriebssystem.
CAPTURE_Error(waveInAddBuffer_(rec\wave, inHdr(i), SizeOf(WAVEHDR))) ;Die waveInAddBuffer Funktion sendet einen Eingangspuffer, um den gegebenen Wellenform-Audioeingabegerät. Wenn der Puffer voll ist, wird die Anwendung informiert.
Next
CAPTURE_Error(waveInStart_(rec\wave)) ;Diese Funktion startet Eingang auf dem angegebenen Wellenform-Eingabegerät.
SetTimer_(WindowID(#winMain), 0, #BUFFER_TICK, 0)
EndIf
EndProcedure
;==============================================================================
Procedure CAPTURE_Stop()
Protected.i i
If rec\wave
CAPTURE_Error(waveInReset_(rec\wave)) ;Die Funktion waveInReset stoppt Input auf der vorhandenen Wave-Audio-Eingabegerät und setzt die aktuelle Position auf Null (zurück). Alle ausstehenden Puffer sind als erledigt markiert und werden zur Anwendung "zurückgeschickt".
CAPTURE_Error(waveInStop_(rec\wave)) ;Die Funktion waveInStop stoppt Wave-Audio input.
For i = 0 To #BUFFER_NUM - 1
CAPTURE_Error(waveInUnprepareHeader_(rec\wave, inHdr(i), SizeOf( WAVEHDR ))) ;Diese Funktion bereinigt die Vorbereitung durch waveInPrepareHeader durchgeführt. Die Funktion muss aufgerufen werden, nachdem die Gerätetreiber füllt einen Datenpuffer und gibt sie an die Anwendung. Sie müssen diese Funktion vor der Befreiung der Datenpuffer nennen.
Next
CAPTURE_Error(waveInClose_(rec\wave)) ;Diese Funktion schließt die angegebene Wellenform-Audio-Eingabegerät.
EndIf
KillTimer_(WindowID(#winMain), 0)
EndProcedure
;==============================================================================
Procedure CAPTURE_Read(hWaveIn.i, lpWaveHdr.i)
CAPTURE_Error( waveInAddBuffer_( hWaveIn, lpWaveHdr, SizeOf( WAVEHDR ) ) )
rec\buffer = PeekL( lpWaveHdr )
rec\size = PeekL( lpWaveHdr + 8 )
rec\update = #True
FILE_Append()
EndProcedure
;***********************************************************************************
;- PROCS FILE
;***********************************************************************************
Procedure FILE_Create()
Protected.s fileName
fileName = SaveFileRequester( #STR_SAVEREQ, "D:\test.raw", "Son brut|(*.raw)", 0 )
If fileName
file = CreateFile(#PB_Any, fileName)
If file
FILE_Recording( #True )
StatusBarText( #StatusBar, #StatusFile, fileName)
Else
MessageRequester(#STR_ERROR, #STR_PBFILE, #MB_ICONERROR)
EndIf
EndIf
EndProcedure
;==============================================================================
Procedure FILE_Append()
If rec\recording = #True
rec\recorded + rec\size
WriteData(file, rec\buffer, rec\size )
StatusBarText( #StatusBar, #StatusInfo, Str(rec\recorded) + #STR_RECORDED )
EndIf
EndProcedure
;==============================================================================
Procedure FILE_Recording( state.b )
If state = #True
rec\cback = #COLOR_RECBACK
rec\cline = #COLOR_RECLINE
rec\cwave = #COLOR_RECWAVE
Else
rec\cback = #COLOR_CAPBACK
rec\cline = #COLOR_CAPLINE
rec\cwave = #COLOR_CAPWAVE
EndIf
DisableToolBarButton(0, #gadRecord, state )
DisableToolBarButton(0, #gadStop, #True-state )
rec\recording = state
rec\recorded = 0
EndProcedure
;==============================================================================
Procedure FILE_Close()
If rec\recording = #True
FILE_Recording( #False )
CloseFile(file)
StatusBarText( #StatusBar, #StatusFile, #STR_CLOSED )
EndIf
EndProcedure
;***********************************************************************************
;- PROCS GUI
;***********************************************************************************
Procedure GUI_Button( id.l, ico.l, tip.s )
ToolBarStandardButton( id, ico )
ToolBarToolTip(0, id, tip )
EndProcedure
;==============================================================================
Procedure.i GUI_Init()
Protected.i canvas
If Not OpenWindow(#winMain, 0,0,320,160, "" , #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
ProcedureReturn #False
EndIf
If Not CreateToolBar(0, WindowID(#winMain))
ProcedureReturn #False
EndIf
canvas = CanvasGadget(#PB_Any, 0,0,100,100, #PB_Canvas_Border)
If Not CreateStatusBar(#StatusBar, WindowID(#winMain))
ProcedureReturn #False
EndIf
rec\output = canvas;CanvasOutput(canvas);WindowOutput(#winMain)
GUI_Button(#gadRecord, #PB_ToolBarIcon_Save, #STR_RECORD)
GUI_Button(#gadStop, #PB_ToolBarIcon_Delete, #STR_STOP )
GUI_Button(#gadMode, #PB_ToolBarIcon_Properties, #STR_MODE )
AddStatusBarField( 80 )
AddStatusBarField( 150 )
AddStatusBarField( $FFF )
ProcedureReturn #True
EndProcedure
;==============================================================================
Procedure GUI_Resize()
rec\x = 2
rec\y = 30
rec\w = WindowWidth(#winMain)-4
rec\h = WindowHeight(#winMain)-52
rec\m = rec\y + rec\h / 2
ResizeGadget(rec\output, rec\x-2, rec\y-2, rec\w+4, rec\h+4 )
EndProcedure
;==============================================================================
Procedure GUI_CallBack(hWnd.i, uMsg.i, wParam.i, lParam.i) ;-Das muss auch rein (wegen #MM_WIM_DATA).
Protected.i result
result = #PB_ProcessPureBasicEvents
Select uMsg
Case #MM_WIM_DATA
CAPTURE_Read(wParam, lParam)
Case #WM_TIMER
CAPTURE_Draw()
Case #WM_SIZE
GUI_Resize()
Case #WM_COMMAND
Select wParam
Case #gadRecord
FILE_Create()
Case #gadStop
FILE_Close()
Case #gadMode
rec\mode = #True - rec\mode
EndSelect
EndSelect
ProcedureReturn result
EndProcedure
;==============================================================================
Procedure GUI_Main()
If GUI_Init()
SetWindowCallback(@GUI_CallBack())
FILE_Recording( #False )
GUI_Resize()
CAPTURE_Start()
While WaitWindowEvent()<>#PB_Event_CloseWindow : Wend
CAPTURE_Stop()
EndIf
EndProcedure
;***********************************************************************************
;- START
;***********************************************************************************
GUI_Main()
End