Generating a tone in VB6

[fireman87]

Hi,

Can anyone tell me how I can generate a tone in VB6 I need to be able to set the frequency and duration in ms it also needs to go to the line out or speaker out of the sound card.

I have limited programming experience, so a detailed explanation is appreciated

Thanks..

[Robbie]

Hi. I know how to do exactly what you want pretty easily, apart from the fact that it comes out of the internal PC speaker / 'bleeper' rather than the soundcard.
Unfortunately though, for what you want, I only know how to do it a rather long-winded way - but hey, at least it gets the job done ;) (...eventually <_<)

For this I recommend using the FMOD sound engine.
You can download it there (it's free), and it comes with quite a lot of examples for VB6 (I presume you're not using .NET...?).

This tutorial should get you a program which can produce (and change frequency of) a tone in realtime (don't need to make any WAV file). Since you say you're new to VB, I'll try to go in a pretty step-by-step fashion.

- Download and install the FMOD Programmers' API.
- Start VB and choose to create a Standard EXE.
The next thing you need to do is to save the project (yes, it's just a blank form so far). To keep everything neat and easy to keep track of, I suggest you put it in its own new folder.
- Wherever you save it, the next thing to do is copy fmodex.dll (you'll find it where you installed FMOD, in the api folder) and paste it into the folder which you saved the VB project in.
- Then, back in the FMOD program folder, in api/vb copy those 4 VB Modules and paste them into the folder which your project's saved in (gotta keep everything together, makes it so much easier to maintain).
- On your project on VB, in the Project Explorer area (usually top-right - it's the bit where you'll see the forms, modules and other things used in your project), right-click, choose Add, click Module.
- On the Add Module window, choose the Existing tab and open one of the 4 Modules.
- Do the same to add the other 3 Modules so you end up with all 4 added to your project.

Now for the main coding part! >=D

- Double-click on your form so that you get to editing the Form_Load() sub's code.
- Type this (or better still, copy-and-paste) :

OUTSIDE of the Form_Load() sub (at the top of the code window, the General Declarations area) :
[code=vb]
Dim MainSystem As Long
Dim ToneChannel As Long
Dim DSPID as Long
[/code]

INSIDE the Form_Load() sub:
[code=vb]
Dim Result As FMOD_RESULT
Dim Version As Long

' Create our main system object and initialize. Its ID will be stored in the variable 'MainSystem', so we can refer to it later.
Result = FMOD_System_Cre ate(MainSystem)
ERRCHECK (Result)
'Note that after every FMOD function, we'll tell VB to make sure that FMOD gave back no error (hence the ERRCHECK(Result ))

'Find out what version of FMOD the DLL (fmodex.dll) is, store it in 'Version' variable
Result = FMOD_System_Get Version(MainSys tem, Version)
ERRCHECK (Result)

'FMOD_VERSION is a variable held in one of the 4 modules we added. Those modules were made for that specific version of FMOD.
'Therefore we have to make sure the DLL is of the same version, otherwise there could be incompatibiliti es (this is mainly for if you're gonna give the program to other people, because we need to make sure they have the same version of FMOD's DLL as the program needs)
If Version <> FMOD_VERSION Then
'If it's not the right version, show an error
MsgBox "Error! You are using an old Version of FMOD " & Hex$(Version) & ". " & _
"This program requires " & Hex$(FMOD_VERSI ON)
End If

'Initialize our system (MainSystem)!
Result = FMOD_System_Ini t(MainSystem, 2, FMOD_INIT_NORMA L, 0)
'MainSystem means that's the system we want to initialize, which we created earlier (yes, you can even use multiple 'systems' at once...)
'2 = the maximum number of channels which will be able to play on this system - i.e. we're telling it that only as many as 2 sounds need to be able to play at any one time here. I know you actually only need 1, but I like to use slightly more than necessary e.g. so I can tell if I accidentally tell a sound to play twice.
ERRCHECK (Result)

'Create a DSP which will make the tone which you want.
'A DSP is a 'unit' in FMOD which can either create sound from scratch (what we're using it for here - meaning that it's called a DSP oscillator), or to filter sound, e.g. bass boost or add a reverb)
'We're storing the ID of this DSP unit in the variable DSPID, which we can then use later to refer to this specific DSP unit, as we did with MainSystem.
Result = FMOD_System_Cre ateDSPByType(Ma inSystem, FMOD_DSP_TYPE_O SCILLATOR, DSPID)
ERRCHECK (Result)

'Set the frequency of our DSP oscillator
Result = FMOD_DSP_SetPar ameter(DSPID, FMOD_DSP_OSCILL ATOR_RATE, 4000)
'That means 4,000 Hz
ERRCHECK (Result)

'Set the type of the to Square
Result = FMOD_DSP_SetPar ameter(DSPID, FMOD_DSP_OSCILL ATOR_TYPE, 1)
ERRCHECK (Result)
'1 means Square waveform (sounds like the internal PC speaker). Also available are Sine wave (pure 'hum'), sawtooth, triangle, white noise (not in that order, and I can't remember what number means which. I thing 0 for Sine and 4 for WhiteNoise, but I can't remember off the top of my head. You can change it and see for yourself anyway if you need to.


'You play a sound on a channel - whether from a sound file or being made in realtime, like with this DSP unit.
'It is simpler to have the DSP permanently making a tone, and just pause/unpause the channel which it's playing on, than to actually keep stopping and starting the DSP itself.
'(Just trust me ;) )
'Start playing it on a channel. We've told FMOD that there should only be 2 channels available. FMOD will play the DSP on the first available channel, or if there is no channel available, the one which had something starting playing on it the longest time ago (therefore probably least important).
Result = FMOD_System_Pla yDSP(System, FMOD_CHANNEL_RE USE, DSPID, 1, ToneChannel)
ERRCHECK (Result)
'The ID of the channel which it uses is stored in our variable ToneChannel.
'1 means that it WILL start paused. A 0 here would mean no, it will start producing sound straight away, not wait for us to unpause it.

'One more thing needs to be done to protect your precious speakers and ears - turn down the volume of that channel which will play the DSP! (Well, it already will be playing, just paused)
Result = FMOD_Channel_Se tVolume(ToneCha nnel, 0.125)
ERRCHECK (Result)
'Volumes range from 0 to 1. So 0.125 may seem like a very low volume. However, the volumes are logarithmic, meaning that it makes more of a difference lower down, e.g. the difference between 0.1 and 0.2 is more obvious than 0.6 and 1.
[/code]

You should see a sub called ERRCHECK being called many times to check for and display any errors FMOD gave back for the last thing we told it to do. But that ERRCHECK function doesn't exist, so we need to make it.
Put this at the absolute bottom of the code window (outside any subs)
[code=vb]
Private Sub ERRCHECK(Result As FMOD_RESULT)

If Result <> FMOD_OK Then
MsgBox "FMOD error! (" & Result & ") " & FMOD_ErrorStrin g(Result)
End If

End Sub
[/code]

The next thing you must do, before we even try to hear the sound, is SAVE THE FORM before we crash VB and lose it!
It's very easy for VB to crash while we play around with FMOD.
If you forget to shut down the system (MainSystem) before exitting the program,VB will crash, simple as that.

- So next, on the code window, in the top-left pulldown menu choose Form, and in the top-right menu choose Unload.
We're gonna tell VB to shut down our MainSystem on FMOD whenever the form is about to close, to avoid VB crashing!
- In the Form_Unload() sub, copy/paste this:
[code=vb]
If MainSystem Then
Result = FMOD_System_Clo se(System)
Result = FMOD_System_Rel ease(System)
End If
[/code]

Now you have to remember to never use the Stop button on VB (next to the Play button you click to run your program), unless you have saved, because it will crash because of us not shutting down MainSystem! However, if you exit the form as you'd have to when your program's made, it won't crash now.

Right, we're ready to try to hear the sound now!
- Create a CheckBox on the form and call it ToneCheck.
- Double-click it to get typing code in the ToneCheck_Click () sub.
- Copy/paste this into that sub:
[code=vb]
If ToneCheck.Value = 1 Then
'The checkbox is ticked! We need to set ToneChannel's paused state to 0 (not paused!)
'(In English: we need to unpause the channel so we can hear the tone!)

Result = FMOD_Channel_Se tPaused(ToneCha nnel, 0)
ERRCHECK (Result)
'0 = unpaused
Else
'Checkbox is unchecked - we don't want to hear the tone, pause ToneChannel!
Result = FMOD_Channel_Se tPaused(ToneCha nnel, 1)
ERRCHECK (Result)
'1 = paused
End If

Save now and run it, and check/uncheck the box. Hopefully this is what you need.
You can change the frequency of the DSP unit by using this code:
[code=vb]
Result = FMOD_DSP_SetPar ameter(DSPID, FMOD_DSP_OSCILL ATOR_RATE, YourNewFrequenc y)
ERRCHECK (Result)
[/code]

I know that you wanted it to be so that you gave it the frequency and duration. Well here's a little sub which does that:
[code=vb]
Public Sub FMODBeep(Freque ncy, Duration as Long)
Result = FMOD_DSP_SetPar ameter(DSPID, FMOD_DSP_OSCILL ATOR_RATE, Frequency)
ERRCHECK(Result )
'That set the frequency to Frequency (Hz)
Result = FMOD_Channel_Se tPaused(Channel , 0)
ERRCHECK (Result)
'That 'turned the tone on'
MsgWaitObj Duration
'That's making it wait for the Duration you gave (milliseconds)

Result = FMOD_Channel_Se tPaused(Channel , 1)
ERRCHECK (Result)
'That's pausing the channel again after we've heard the tone for as long as we want to.

End Sub
[/code]
There's a call to a sub there called MsgWaitObj.
That makes VB wait there until a certain amount of time has passed, without maxing out the processor and without stopping the program from responding.
To be able to use it, add another Module (this time, New), and paste this into it:
[code=vb]
'-----
'INSANE COMPLEXNESS FOR NON-LOCKING SLEEP:
'START
'-----
'************** *************** ***************
'* (c) 1999-2000 Sergey Merzlikin *
'************** *************** ***************

Private Const STATUS_TIMEOUT = &H102&
Private Const INFINITE = -1& ' Infinite interval
Private Const QS_KEY = &H1&
Private Const QS_MOUSEMOVE = &H2&
Private Const QS_MOUSEBUTTON = &H4&
Private Const QS_POSTMESSAGE = &H8&
Private Const QS_TIMER = &H10&
Private Const QS_PAINT = &H20&
Private Const QS_SENDMESSAGE = &H40&
Private Const QS_HOTKEY = &H80&
Private Const QS_ALLINPUT = (QS_SENDMESSAGE Or QS_PAINT _
Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON _
Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY)
Private Declare Function MsgWaitForMulti pleObjects Lib "user32" _
(ByVal nCount As Long, pHandles As Long, _
ByVal fWaitAll As Long, ByVal dwMilliseconds _
As Long, ByVal dwWakeMask As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
'-----
'INSANE COMPLEXNESS FOR NON-LOCKING SLEEP:
'END
'-----





' The MsgWaitObj function replaces Sleep,
' WaitForSingleOb ject, WaitForMultiple Objects functions.
' Unlike these functions, it
' doesn't block thread messages processing.
' Using instead Sleep:
' MsgWaitObj dwMilliseconds
' Using instead WaitForSingleOb ject:
' retval = MsgWaitObj(dwMi lliseconds, hObj, 1&)
' Using instead WaitForMultiple Objects:
' retval = MsgWaitObj(dwMi lliseconds, hObj(0&), n),
' where n - wait objects quantity,
' hObj() - their handles array.

Public Function MsgWaitObj(Inte rval As Long, _
Optional hObj As Long = 0&, _
Optional nObj As Long = 0&) As Long
Dim T As Long, T1 As Long
If Interval <> INFINITE Then
T = GetTickCount()
On Error Resume Next
T = T + Interval
' Overflow prevention
If Err <> 0& Then
If T > 0& Then
T = ((T + &H80000000) _
+ Interval) + &H80000000
Else
T = ((T - &H80000000) _
+ Interval) - &H80000000
End If
End If
On Error GoTo 0
' T contains now absolute time of the end of interval
Else
T1 = INFINITE
End If
Do
If Interval <> INFINITE Then
T1 = GetTickCount()
On Error Resume Next
T1 = T - T1
' Overflow prevention
If Err <> 0& Then
If T > 0& Then
T1 = ((T + &H80000000) _
- (T1 - &H80000000))
Else
T1 = ((T - &H80000000) _
- (T1 + &H80000000))
End If
End If
On Error GoTo 0
' T1 contains now the remaining interval part
If IIf((T1 Xor Interval) > 0&, _
T1 > Interval, T1 < 0&) Then
' Interval expired
' during DoEvents
MsgWaitObj = STATUS_TIMEOUT
Exit Function
End If
End If
' Wait for event, interval expiration
' or message appearance in thread queue
MsgWaitObj = MsgWaitForMulti pleObjects(nObj , _
hObj, 0&, T1, QS_ALLINPUT)
' Let's message be processed
DoEvents
If MsgWaitObj <> nObj Then Exit Function
' It was message - continue to wait
Loop
End Function
[/code]

Sorry for the absolutely ridiculous length of this post!
Good luck~!
If you have any more questions, please ask! ^^

[Robbie]

Woah~... I noticed missed-out words, wrong words ('thing' instead of 'think'), no close brackets...
I blame it on the fact that it's 6:07 AM and I haven't been to sleep yet. -"-;

EDIT: Sorry for double-post, I can't read my entire tutorial in just 5 minutes to edit it within 5 minutes >_<

[fireman87]

Hi Robbie,

Thanks for writing this answer to my question, this is very helpfull .
I will go and try this out.
Thanks again for taking the time to do this.

[fireman87]

Hi Robbie,

I have done everything your said in your posting but run into a couple of problems.
While trying to add the last module (fmodexp) it came up with the following 2 error messages

"Name conflicts with existing module, project or object library"

Then it comes up with the following

"An error occurred while background loading module"module 1".
Background load will now abort and the code for some modules may
not be loaded. saving these modules to there current file name will
result in code loss. Please load a new project."

I tried this several times but every time it is the same and I don't see duplicate names so I don't know where the problem is.

It will create a "module 1 (fmodexp.bas)" but this is empty.

I guess that this is the reason I get other error messages when running the program.

If it is more helpfull I can email you the folder with what I have done so far.

Thanks

[Killer42]

... I can't read my entire tutorial in just 5 minutes to edit it within 5 minutes >_<

Someone told me recently that the five-minute limit on editing had been increased to one hour. Is this not the case?

[Robbie]

While trying to add the last module (fmodexp) it came up with the following 2 error messages

I downloaded the latest version from their web site and it doesn't work for me either, but because of other errors.
I'm sorry, you only should have tried to load modules:
fmod_errors
fmod_dsp
fmodex
It seems they're just rushing and not paying attention to the VB stuff because they think that C++ or other languages there are more important, or something. <_<

I'm uploading a ZIP file which contains the version of FMOD I'm using.
The ZIP contains the 3 VB modules, and the fmodex.dll.
Hope this works! (It should, since they're the exact files I'm using)
FMOD_v4_6_21_fo r_VB.zip

[jnherm]

Hi Robbie,
I use this code you suggested and all corrections you"ve made and yet i have problems running my prog...Whenever a function with ToneChannel parameter is called error will result..It says invalid parameter was passed to this function!err#37 ..
What happen?
Functions with errors are:

FMOD_System_Pla yDSP(...)
FMOD_Channel_Se tVolume(...) and
FMDO_Channel_Se tPaused(...)

[Robbie]

*Sigh*
I knew I should've tested this before I told you to do make it.

Just to let you know, I'm working on an example project on VB, I'll give you a link to it when I'm done. ;)

[Robbie]

Here you go! =D
I found several errors in my code, the worst one being I typed System instead of MainSystem (because that was code which I'd copied from another of my programs and forgotten to change >_<)

Enjoy! ^^
Please let me know how it goes
Generate_Tone_e xample.zip

[jnherm]

Thanks so much Robbie for sample program!!!

[John Alexander]

Option Explicit
Private Declare Function GetMem8 Lib "msvbvm60" (ByRef src As Any, ByRef Dst As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (ByRef src As Any, ByRef Dst As Any) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundW " (ByRef pData As Any, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) As Long
Private Const SND_MEMORY = &H4
Dim x As Integer

Private Function PlayTone(ByVal fFrequency As Single, ByVal fDurationMS As Single) As Boolean
Dim bData() As Byte
Dim lSize As Long
Dim lSamples As Long
Dim lIndex As Long
Dim fPhase As Single
Dim fDelta As Single
lSamples = 44.1 * fDurationMS
lSize = lSamples + 44
fDelta = fFrequency / 44100 * 6.2831853071795 9
ReDim bData(lSize - 1)
GetMem4 &H46464952, bData(0): GetMem4 CLng(lSize - 8), bData(4)
GetMem8 233861439252950 .2551@, bData(8)
GetMem8 28147927167.796 8@, bData(16)
GetMem8 18940805779.77@ , bData(24)
GetMem8 702234480110259 .4049@, bData(32)
GetMem4 lSamples, bData(40)
For lIndex = 0 To lSamples - 1
bData(lIndex + 44) = Sin(fPhase) * 127 + 128
fPhase = fPhase + fDelta
If fPhase > 6.2831853071795 9 Then fPhase = fPhase - 6.2831853071795 9
Next
PlaySound bData(0), 0, SND_MEMORY
End Function



Private Sub Form_Load()
For x = 300 To 1100 Step 9
PlayTone x, 8
Next
For x = 900 To 300 Step -9
PlayTone x, 7
Next
' the x is frequency and the number is duration
End
End Sub