0
0

Could someone please review the following code for me? This was working when I last looked at it, but now for some reason, one part is not …

This is a simple VB6 conversion of the C++ recording example

You will need a form with a button (cmdStartRecording), a timer (Timer_Meter), and 2 labels (Label1 and lblInfo), also the fmod.bas file

The recording of a sample to a .wav file is fine. What does not seem to be working (but was before) was Timer_Meter_Timer(), where I show the current VU levels. In the non cutdown version of this project, I have 2 labels that shrink and grow with the levels of the left and right channels. Last week, these were working fine. Now they are not. 😥

Can anyone please help?

‘=== Start Copy here ===
Option Explicit

Dim SampleHandle As Long
Dim PlayChannel As Long
Dim origFreq As Long

Const RECORDRATE = 44100 ‘kHz
Const RECORDTIME = 5 ‘seconds

Const RECORDMONO = 1
Const RECORDSTERO = 2

Const RECORD8BIT = 1
Const RECORD16BIT = 2

Const RECORDDELAY = 25
Const RECORD_DELAY_SAMPLES = (RECORDRATE * RECORDDELAY / 1000)

Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

Private Sub Form_Load()
Dim result As Boolean

result = FSOUND_SetOutput(FSOUND_OUTPUT_DSOUND)

‘This is the first thing you have to do before you can start working with fmod
result = FSOUND_Init(44100, 32, FSOUND_INIT_ACCURATEVULEVELS)
If result = True Then
‘Successfully initialized
Else
‘An error occured
MsgBox “An error occured initializing fmod!” & vbCrLf & FSOUND_GetErrorString(FSOUND_GetError)
End If

Timer_Meter.Interval = 100

End Sub

Private Sub Form_Unload(Cancel As Integer)
FSOUND_Close
End Sub

Private Sub cmdStartRecording_Click()
Start_Recording
End Sub

Sub Start_Recording()
Dim result As Boolean

‘allocate the specs of what we are going to record:
‘ – stero, 16-bit, max on both left and right channels, full volume, high priority
SampleHandle = FSOUND_Sample_Alloc(FSOUND_UNMANAGED, RECORDRATE * RECORDTIME, FSOUND_STEREO Or FSOUND_16BITS, RECORDRATE, 255, 128, 255)

‘start recording
result = FSOUND_Record_StartSample(SampleHandle, False)
If result = False Then
MsgBox “Recording failed for the following reason …” & vbCrLf & vbCrLf & FSOUND_GetErrorString(FSOUND_GetError), vbExclamation
End If

Timer_Meter.Enabled = True

Do
If FSOUND_Record_GetPosition() = 0 Then Exit Do
Sleep 1
DoEvents
Loop

PlayChannel = FSOUND_PlaySound(FSOUND_FREE, SampleHandle)
result = FSOUND_SetVolume(PlayChannel, 0)

origFreq = FSOUND_GetFrequency(PlayChannel)

Do
If FSOUND_Record_GetPosition() >= RECORDRATE * RECORDTIME Then Exit Do

  Sleep 100 ' delay a tenth of a second while recording. 
  DoEvents

Loop

Stop_Recording

MsgBox “done”

End Sub

Sub Stop_Recording()
Dim result As Boolean

Timer_Meter.Enabled = False

result = FSOUND_StopSound(PlayChannel)
If result = False Then
MsgBox “Stopping failed for the following reason …” & vbCrLf & vbCrLf & FSOUND_GetErrorString(FSOUND_GetError), vbExclamation
End If

result = FSOUND_Record_Stop()
If result = False Then
MsgBox “Stop recording failed for the following reason …” & vbCrLf & vbCrLf & FSOUND_GetErrorString(FSOUND_GetError), vbExclamation
End If

SaveToWav

End Sub

Private Sub Timer_Meter_Timer()
‘=== THIS IS NOT WORKING !!! ===
Dim result As Boolean

Dim ChLeft As Single
Dim ChRight As Single

Dim Playpos As Long
Dim Recpos As Long
Dim Diff As Long

Playpos = FSOUND_GetCurrentPosition(PlayChannel)
Recpos = FSOUND_Record_GetPosition()

‘lblInfo.Caption = Recpos
‘5 sec sample @ 44100 kHz should be 220500 samples
‘DoEvents

Diff = Playpos – Recpos

If Diff > -RECORD_DELAY_SAMPLES Then
FSOUND_SetFrequency PlayChannel, origFreq – 1000

ElseIf Diff < -(RECORD_DELAY_SAMPLES * 2) Then
FSOUND_SetFrequency PlayChannel, origFreq + 1000

Else
FSOUND_SetFrequency PlayChannel, origFreq

End If

result = FSOUND_GetCurrentLevels(PlayChannel, ChLeft, ChRight)

If result = False Then
If Len(Label1.Caption) <= 0 Then
Label1.Caption = “Error : ” & FSOUND_GetErrorString(FSOUND_GetError)
DoEvents
End If
End If

lblInfo.Caption = ChLeft & ” ” & ChRight
DoEvents

End Sub

Sub SaveToWav()
‘ usage notes:

Dim wavData() As Byte ‘ buffer to hold data
Dim ptr1 As Long
Dim ptr2 As Long
Dim len1 As Long
Dim len2 As Long
Dim result As Boolean
Dim recordbytes As Long
Dim wav_header$
Dim filename As String

‘ Dim alloc_needs_this As Long
‘ Dim recordsamples As Long
‘ filepath As String, recordrate As Long, recordtime As Single, monostereo As Integer, bytespersample As Integer

‘ the following may have been needed in case less than recordsamples was actually recorded
‘ # seconds
recordbytes = Int(FSOUND_Sample_GetLength(SampleHandle) * RECORDSTERO * RECORD16BIT)

‘========= the following is to explain basic WAV pcm (non-compressed) format
‘ % indicates a hex value for a byte.
‘ In wav files, everything except the text fields are in little endian (reverse the bytes):
‘ 16000 => %3E%80 => %80%3E (16,000 in hex and in little endian)
‘ but sample rate is stored as 4 bytes, so 16,000 => %00%00%3E%80 => %80%3E%00%00
‘ dec2endian is for doing the conversion for exactly 4 bytes.

‘ below is how a WAV file header looks in Hex when opened with an editor with Hex:
‘ the parentheses below are for seperation clarity
‘==========================================
‘ RIFF
‘ (4 bytes specifying file size minus 8 bytes which is also 36 bytes plus wav data)
‘ WAVEfmt(%20)
‘ (%10%00%00%00)(%01%00)(%01 for mono, %02 for stereo)(%00)
‘ (4 bytes = sample rate … remember all bytes are reversed)
‘ (4 bytes = SampleRate * NumChannels * BitsPerSample/ 8)
‘ (1 byte = NumChannels * BitsPerSample/ 8 e.g. %02 represents 16 bit mono)(%00)
‘ (1 byte = BitsPerSample: 8 or 16, i.e. %08 or %10)(%00)
‘ data
‘ (4 bytes for file size minus 44, the actual size of the raw wav data which follows immediately)
‘ (actual wav data begins here)
‘==========================================
‘ if wav data is stereo, alternate the 1 byte [8-bit] or 2 byte [16-bit] samples like
‘ this: L,R,L,R,L,R,etc.
‘ 8-bit samples are stored as unsigned single bytes, ranging from 0 to 255, in hex that’s %00 to %FF
‘ 128 (%80) is zero or maybe +1.
‘ 16-bit [2 byte] samples are in a format called “2’s-complement signed”,
‘ ranging from -32768 to 32767. In hex, that’s 0000 up to 7FFF for positive and FFFF down to
‘ 8000 for negative. Oddly enough, 8000 is the lowest negative value.
‘ but they are stored in little endian so volume +23,661 => %5C%6D => %6D%5C
‘ negative example: -23,661 => 65535-23661=41874 => %A3%92 => (little endian) %92%A3

‘ Each chr$() returns a byte of ASCII text (a hex value in bits). It helps to have a
‘ calculator with base conversion and an ascii chart in hex and decimal. Note that chr(1)=%01,
‘ chr(2)=%02, chr(16)=%10, chr(15)=%FF, and chr(32)=%20=(space).

wav_header$ = “RIFF” & dec2endian(recordbytes + 36) & “WAVEfmt” & Chr$(32) & _
Chr$(16) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(1) & Chr$(0) & Chr$(RECORDSTERO) & Chr$(0) & _
dec2endian(RECORDRATE) & dec2endian(Int(RECORDRATE * RECORDSTERO * RECORD16BIT)) & _
Chr$(Int(RECORDSTERO * RECORD16BIT)) & Chr$(0) & _
Chr$(Int(8 * RECORD16BIT)) & Chr$(0) & “data” & dec2endian(recordbytes)

filename = App.Path & “\” & Format$(Now, “yyyy-mm-dd hh-nn-ss”) & “.wav”

On Error GoTo Write_Error

Open filename For Binary As #1

Put #1, , wav_header$ ‘ without the $ it was printing 4 bytes at the beginnning

‘ by the following not using ptr2 or len2, it assumes the recording above did not go
‘ past the buffer specified by recordsample in FSOUND_sample_alloc above…and it shouldn’t
result = FSOUND_Sample_Lock(SampleHandle, 0, recordbytes, ptr1, ptr2, len1, len2)

If Not result Then MsgBox FSOUND_GetErrorString(“Sample Lock Error: ” & FSOUND_GetError), vbOKOnly

‘ReDim Preserve wavData(0 To len1 – 1) As Byte
ReDim Preserve wavData(0 To len1 – 1)

Call CopyMemory(wavData(0), ByVal ptr1, len1)
‘ at this line you can modify pcmData WAV data before saving

Put #1, , wavData
result = FSOUND_Sample_Unlock(SampleHandle, ptr1, ptr2, len1, len2)
If Not result Then MsgBox FSOUND_GetErrorString(“Sample Unlock Error: ” & FSOUND_GetError), vbOKOnly

Close #1

FSOUND_Sample_Free (SampleHandle)

Erase wavData

FSOUND_Close

Exit Sub

Write_Error:
MsgBox Err.Description
Resume Next

End Sub

Public Function dec2endian(ByVal dec_num As Long) As String
‘ converts a decimal number to 4 byte little endian ascii character string
Dim a As String
Dim b As String
Dim c As String
Dim d As String

Dim aa As Long
Dim bb As Long
Dim cc As Long
Dim dd As Long

dd = Int(dec_num / 16777216)

cc = Int((dec_num – dd * 16777216) / 65536)

bb = Int((dec_num – dd * 16777216 – cc * 65536) / 256)

aa = dec_num – dd * 16777216 – cc * 65536 – bb * 256

a = Chr$(aa)
b = Chr$(bb)
c = Chr$(cc)
d = Chr$(dd)

dec2endian = a & b & c & d

End Function

  • You must to post comments
0
0

[quote="Divot":2tw2hh13]Could someone please review the following code for me? This was working when I last looked at it, but now for some reason, one part is not …

————- snip 8< ————————-

PlayChannel = FSOUND_PlaySound(FSOUND_FREE, SampleHandle)
[b:2tw2hh13]result = FSOUND_SetVolume(PlayChannel, 0)[/b:2tw2hh13] 😳

————- snip 8< ————————-

[/quote:2tw2hh13]

WHAT A DICK! of course it helps to read your code in more detail before posting dumb questions … 😳 it helps to have volume if you’re going to use VU meters …….

sorry for wasting everyone’s time ….

Divot

  • You must to post comments
Showing 1 result
Your Answer

Please first to submit.