0
0

I was not happy with the answers for the last discussion on this so I thought I would try again. Here is some code that is designed to implement most of the stream2.c example in Visual Basic. It runs but only produces quiet clicks. Does anybody know what is wrong with this code? Byte order is not the problem.

[code:2igthhq7]
Option Explicit
‘ Try to implement the crucial parts of the stream2.c project in VB\
‘ Just call DoMain routine.
‘ Runs but only makes small clicking sound.
‘ What is wrong?

‘ R. Still 12-12-03

Private Type anint
ival As Integer
End Type

Private Type twobytes
byte1 As Byte
byte2 As Byte
End Type

Dim CallBackCount As Long
Dim t1 As Single, t2 As Single ‘ time
Dim v1 As Single, v2 As Single ‘ velocity

Function streamcallback(ByVal stream As Long, buff() As Byte, ByVal dlen As Long, ByVal param As Long) As Long
Dim count As Long
Dim byte1 As Byte, byte2 As Byte
Dim nsamps As Long
Dim ibuf As Long
Dim intval As Integer
Dim astr As String

On Error GoTo anerr
ReDim buff(1 To dlen)

nsamps = dlen / 4

ibuf = 1
astr = ""
For count = 1 To nsamps            ' //  16bit stereo (4 bytes per sample) (Should NOT be -1 ???)

    intval = Sin(t1) * 32767        '    // left channel
    IntToBytes intval, byte1, byte2
    buff(ibuf) = byte1
    buff(ibuf + 1) = byte2
    If count < 6 Then astr = astr & " I>" & intval & "=" & byte1 & ":" & byte2

    intval = Sin(t2) * 32767        '    // right channel
    IntToBytes intval, byte1, byte2
    buff(ibuf + 2) = byte1
    buff(ibuf + 3) = byte2
    ibuf = ibuf + 4

    t1 = t1 + 0.01 + v1
    t2 = t2 + 0.0142 + v2
    v1 = v1 + (Sin(t1) * 0.002)
    v2 = v2 + (Sin(t2) * 0.002)
Next count

afterloop:
streamcallback = 1
CallBackCount = CallBackCount + 1
Debug.Print CallBackCount & " " & nsamps & " " & astr
GoTo endit
anerr:
MsgBox "CallBack ERR"
endit:

End Function

Function endcallback(ByVal stream As Long, buff() As Byte, ByVal dlen As Long, ByVal param As Long) As Long
Debug.Print "EndCallBack"
endcallback = 1
End Function

Sub DoMain()
Dim stream As Long
Dim result As Long

If FSOUND_GetVersion() < FMOD_VERSION Then
    MsgBox "Error : You are using the wrong DLL version!  You should be using FMOD " & FMOD_VERSION
    Exit Sub
End If

result = FSOUND_SetOutput(FSOUND_OUTPUT_DSOUND)

Select Case FSOUND_GetOutput()
        Case FSOUND_OUTPUT_NOSOUND
                    Debug.Print "NoSound"
        Case FSOUND_OUTPUT_WINMM
                    Debug.Print "Windows Multimedia Waveout"
        Case FSOUND_OUTPUT_DSOUND
                    Debug.Print "Direct Sound"
        Case FSOUND_OUTPUT_ASIO
                    Debug.Print "ASIO"
        Case Else
                    MsgBox "Output type ERROR " & FSOUND_GetOutput()
                    Exit Sub
End Select

result = FSOUND_Init(44100, 16, 0)
If result <> 1 Then
    MsgBox "An error occured initializing fmod!" & vbCrLf & _
        FSOUND_GetErrorString(FSOUND_GetError), vbOKOnly                ' An error occured
    Exit Sub
End If

stream = FSOUND_Stream_Create(AddressOf streamcallback, 6 * 2048, FSOUND_NORMAL + FSOUND_16BITS + FSOUND_STEREO, 44100, 12345)

result = FSOUND_Stream_SetEndCallback(stream, AddressOf endcallback, 0)

Debug.Print "Stream_Play"
result = FSOUND_Stream_Play(FSOUND_FREE, stream)

If result = -1 Then
    MsgBox "An error occured initializing fmod!" & vbCrLf & _
        FSOUND_GetErrorString(FSOUND_GetError), vbOKOnly
End If

MsgBox "Quit"

result = FSOUND_Stream_Close(stream)
result = FSOUND_Close()

End Sub

Sub IntToBytes(a As Integer, b1 As Byte, b2 As Byte) ‘ Extract bytes from integer
Dim aval As anint
Dim bval As twobytes

aval.ival = a
LSet bval = aval
b1 = bval.byte1
b2 = bval.byte2

End Sub[/code:2igthhq7]

  • You must to post comments
0
0

you are writing your stream callbacks all wrong, here is the correct way:

[code:8f4ms1ak]
Public Function endcallback(ByVal Stream As Long, ByVal buff As Long, ByVal length As Long, ByVal param As Long) As Long

'Put whatever you want it to do here.
endcallback = 1

End Function
[/code:8f4ms1ak]

  • You must to post comments
0
0

Thanks, I changed the callback parameters and tried to use CopyMemory
to fill the buffer. However, the CopyMemory call kills the program.
RS

[code:3h2gpdlk]
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Function streamcallback(ByVal stream As Long, ByVal abuff As Long, ByVal dlen As Long, ByVal Param As Long) As Long

Dim buff() As Byte
ReDim buff(1 To dlen)

...Fill up buff...

CopyMemory abuff, buff(1), dlen

[/code:3h2gpdlk]

  • You must to post comments
0
0

CopyMemory passes parameters ByRef by default, which means it will pass a pointer to the memoryadress where your variables are located.
This is fine for your buffer, since you want to copy that.

The value that the function passes is passed byval, and CONTAINS a pointer to the buffer you want to fill.
If you would pass this as a pointer, you would be passing a pointer to a pointer, which is not very useful, because it is not what the function expects.

To solve this in vb, you should pass the buffer reference ByVal, which is done as follows:
[code:2hhp3exb]CopyMemory ByVal abuff, buff(1), dlen[/code:2hhp3exb]

  • You must to post comments
Showing 3 results
Your Answer

Please first to submit.