Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

FMOD-Test 2 (Aufnahme)

Uploader:RedakteurJojo
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