fb:porticula NoPaste
FMOD-Test 2 (Aufnahme)
Uploader: | Jojo |
Datum/Zeit: | 11.03.2008 21:33:35 |
Option Explicit
#include once "fmod.bi"
const FALSE = 0
const TRUE = not FALSE
Screenres 640,480,8
Dim Shared playbackquali As Integer = 44100 'The standard playback rate... some soundcards may support a higher one
Dim Shared buflen As Integer
buflen = playbackquali*2 '2 sec
If( FSOUND_Init(playbackquali, 1, 0) = FALSE ) Then
Print "Can't initialize FMOD"
End 1
End If
Dim Rec_Buffer As FSOUND_SAMPLE Ptr, posR As Integer, posP As Integer
Rec_Buffer = FSOUND_SAMPLE_Alloc (0,buflen, FSOUND_NORMAL Or FSOUND_LOOP_NORMAL, playbackquali, 100, 0, 1)
FSOUND_Record_StartSample ( Rec_Buffer, 1)
'WHILE FSOUND_Record_GetPosition < buflen/4:WEND 'wait a quarter second for time shifting
'FSOUND_PlaySound(1, Rec_Buffer)
'FSOUND_SetCurrentPosition ( 1 , 0 )
Dim s_ptr1 As Integer Ptr
Dim s_ptr2 As Integer Ptr
Dim offset As Integer
Dim length As Integer
Dim s_len1 As Unsigned Integer
Dim s_len2 As Unsigned Integer
dim mybuf as string
Dim i As Integer
offset = 0
Dim lastwrite As Single
dim fr as integer
Fr=freefile
open "rawrecord.wav" for output as #fr:close #fr
open "rawrecord.wav" for binary as #fr
Do
Screenlock
Line (0,100)-(639,479),0,bf
If (FSOUND_Sample_Lock (Rec_Buffer, offset,buflen,@s_ptr1,@s_ptr2,@s_len1,@s_len2)=FALSE) Then Print "Can't do lock!"
Pset (0,240),4
For i = 0 To 640
Line -(i,(*(s_ptr1+i)/10000000)+240),4
Next i
If offset + 640 < buflen Then offset+=640 Else offset = 0
' If FSOUND_Record_GetPosition > buflen - 500 And Timer > lastwrite +0.3 Then
' Print "Write to disc."
' lastwrite= Timer
' put #Fr,,mybuf
' mybuf=""
' end if
' 'for i = 0 to s_len1
'mybuf += chr(int(*(s_ptr1+i)/5000000)+127)
'next
'put #Fr ,,int(*(s_ptr1+100)/2000000)
FSOUND_Sample_UnLock (Rec_Buffer, @s_ptr1, s_ptr2, s_len1, s_len2)
Screenunlock
Sleep 2
Loop While Inkey$ = ""
close #fr
FSOUND_Record_Stop
FSOUND_Close
End