SOUND FREQUENCY - Problem

I'm using Visual Basic 4.0 ( Unable to upgrade for reasons, to lengthy to describe )
and I'm having trouble generating sound frequencies. What I'm hoping for is to find
some sort of code solution or tips, advice on this.

A simple VB form, with a text box on it, a command button and the relevant code would be sufficient, thanks!
There are two main things I'd like to be able to do, but I'd be happy to come across solutions for either.
First;
I have an application that generates a series of numbers and then dumps these to a text file. The numbers are hertz fequency values to four decimal places. The text file will generally be comma delimited, in a format similiar to;

432.1298
256.9887
333.99
2445.77

and so on....

A text file may contain as little as eight numeric frequency values or up to three thousand.

What I want to do, is feed this text file of numbers into some sort of music generating tool, convert these numbers into actual musical frequencies and store these files as avi, mpeg, wav files, whatever. If I coudl do this in code without having to use a dedicated musical software program that would be great, but I'm open to other sorts
of solutions too.

I'd like to be able to set the time duration for how long each note in the file is played for, i.e. all note are played for 120 seconds, etc....

A 'nice' thing to do also possibly, would be to choose some sort of instrumental sound, like chimes, flute, etc as the instrument the frequencies are to be played on.

Secondly;

I want to specify exact frequencies for play back, NOT just preset values for specific tones, such as one base freq for a given note, its sharp or flat.
Want to play musical notes but NOT just on PC Speaker.
What I'm hoping to figure out;
-Allow any numeric value for frequency in hertz in the format of 888.88 as input into text box for VB application
-Value of frequency in textbox saved to a variable
-Variable passed to relevant routine or ocx component
-Routine or component plays back specific tone frequency on Sound Card (Not PC Speaker)
-Playback allows volume adjustment
I just need something basic and simple to play with to see if it will work for me, all I need is for the sample code to; Allow any numeric value in the format of 888.88 as input into text box
Value in textbox saved to a variable Variable passed to relevant component. Component plays back specific tone frequency Playback allows volume adjustment
==============
I've received a lot fo different tips and advice on how to do all this but nothing that meets all the requirements, i.e.


Hi,
I've seen your software online and noticed you were using something called MMTools to play sounds with.
I just need something basic and simple to play with to see if it will work for me, all I need is for the sample code to; Allow any numeric value in the format of 888.88 as input into text box
Value in textbox saved to a variable Variable passed to relevant component. Component plays back specific tone frequency Playback allows volume adjustment

I've listed some of the things I've already tried below and described why these won't work, and in summary they are;

BeepAPI
How to Emulate QuickBasic's SOUND Statement in Visual Basic
midiOutShortMsg and related

===============
Problem with MIDI;

Also, I love this method, but after reading all the info it looks like it won't actually let me specify exact frequencies for play back, only preset values for specific tones, such as one base freq for a given note, its sharp or flat.
Knowing how to do this is valuable in and of itself, I now can play back musical notes that sound a lot better than the PC Speaker sounds. Sadly this doesn't solve the problem I have though.... :(

create wav file

--------------------------------------------------------------------------------
The following code works but won't let me specify exact frequencies, only tones

This generates a wave file (no clicks or ticks... just clear sound ):
(It makes a 1 second tone of 440 Hz)

VB Code:


Option Explicit

Private Type tWAVEFORMATEX
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
End Type

Private Type FileHeader
lRiff As Long
lFileSize As Long
lWave As Long
lFormat As Long
lFormatLength As Long
End Type

Private Type WaveFormat
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
End Type

Private Type ChunkHeader
lType As Long
lLen As Long
End Type

Private Sub Form_Load()
Dim Buff(0 To 44100) As Integer

GenerateTone 440, Buff, 1

SaveWaveFile "C: est_Wave.wav", Buff
End Sub

Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
Dim K As Long, V1 As Double
Const PI As Double = 3.14159265358979

V1 = SamplesPerSec / (PI * 2 * Frequency)

If Length = -1 Then Length = UBound(IntBuff) - Startpos

For K = Startpos To Startpos + Length
IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
Next K
End Sub

Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
Dim WF As tWAVEFORMATEX

WF.wFormatTag = 1 'WAVE_FORMAT_PCM
WF.nChannels = 1
WF.wBitsPerSample = 16
WF.nSamplesPerSec = SamplesPerSec

WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) 8
WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign

Open WaveFileName For Binary Access Write Lock Write As #1
WaveWriteHeader 1, WF
Put #1, , Buffer
WaveWriteHeaderEnd 1
Close #1
End Sub

Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
Dim header As FileHeader
Dim HdrFormat As WaveFormat
Dim chunk As ChunkHeader

With header
.lRiff = &H46464952 ' "RIFF"
.lFileSize = 0
.lWave = &H45564157 ' "WAVE"
.lFormat = &H20746D66 ' "fmt "
.lFormatLength = Len(HdrFormat)
End With

With HdrFormat
.wFormatTag = WaveFmt.wFormatTag
.nChannels = WaveFmt.nChannels
.nSamplesPerSec = WaveFmt.nSamplesPerSec
.nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
.nBlockAlign = WaveFmt.nBlockAlign
.wBitsPerSample = WaveFmt.wBitsPerSample
End With

chunk.lType = &H61746164 ' "data"
chunk.lLen = 0

Put #OutFileNum, 1, header
Put #OutFileNum, , HdrFormat
Put #OutFileNum, , chunk
End Sub

Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
Dim header As FileHeader
Dim HdrFormat As WaveFormat
Dim chunk As ChunkHeader
Dim Lng As Long

Lng = LOF(OutFileNum)
Put #OutFileNum, 5, Lng

Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
End Sub
===========
===========


This code works, but only allows me to generate sounds to the PC Speaker, which sounds horrible!

Option Explicit
Private Declare Function Beep Lib "kernel32.dll" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub Command1_Click()

Beep 432.8765, 1000

End Sub
================
=========================


This code works for MIDI, but doesn't let me specify exact frequencies only preset musical tones
==================
midiOutShortMsg
The midiOutShortMsg function sends a short MIDI message to the specified MIDI output device.

VB4-32,5,6
Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long

Operating Systems Supported

Requires Windows NT 3.1 or later; Requires Windows 95 or later
=============
PLAY NOTE:

Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Dim hMidiOut As Long
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@allapi.net
Dim T As Long
midiOutOpen hMidiOut, 0, 0, 0, 0
midiOutShortMsg hMidiOut, 6567325
T = Timer
Do: DoEvents: Loop Until Timer > T + 4
midiOutClose hMidiOut
End Sub

----------------------
http://allapi.mentalis.org/apilist/midiOutShortMsg.shtml

===============================

Again, this only works for the PC Speaker


A better beep
If you aren't satisfied with the standard Beep command (who is?) you can use the Beep API function instead, that lets you control both the frequency (in Hertz) and the duration (in milliseconds) of the beep. Note that you need an aliased Declare to avoid a name conflict with the VB command:

Private Declare Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFrequency _
As Long, ByVal dwMilliseconds As Long) As Long

The standard Beep command has a frequency of 440 Hertz and a duration of 200 milliseconds (more or less), so you can produce a short beep with a higher pitch with the following statement:

BeepAPI 600, 100

And of course you can even produce more complex sounds, when a simple beep won't suffice:

Dim i As Long
For i = 100 To 1000 Step 10
BeepAPI i, 20
Next


Comments

  • : create wav file
    :
    : --------------------------------------------------------------------------------
    : The following code works but won't let me specify exact frequencies, only tones
    :
    : This generates a wave file (no clicks or ticks... just clear sound ):
    : (It makes a 1 second tone of 440 Hz)
    :
    : VB Code:
    :
    :
    : Option Explicit
    :
    : Private Type tWAVEFORMATEX
    : wFormatTag As Integer
    : nChannels As Integer
    : nSamplesPerSec As Long
    : nAvgBytesPerSec As Long
    : nBlockAlign As Integer
    : wBitsPerSample As Integer
    : cbSize As Integer
    : ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
    : End Type
    :
    : Private Type FileHeader
    : lRiff As Long
    : lFileSize As Long
    : lWave As Long
    : lFormat As Long
    : lFormatLength As Long
    : End Type
    :
    : Private Type WaveFormat
    : wFormatTag As Integer
    : nChannels As Integer
    : nSamplesPerSec As Long
    : nAvgBytesPerSec As Long
    : nBlockAlign As Integer
    : wBitsPerSample As Integer
    : End Type
    :
    : Private Type ChunkHeader
    : lType As Long
    : lLen As Long
    : End Type
    :
    : Private Sub Form_Load()
    : Dim Buff(0 To 44100) As Integer
    :
    : GenerateTone 440, Buff, 1
    :
    : SaveWaveFile "C: est_Wave.wav", Buff
    : End Sub
    :
    : Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    : Dim K As Long, V1 As Double
    : Const PI As Double = 3.14159265358979
    :
    : V1 = SamplesPerSec / (PI * 2 * Frequency)
    :
    : If Length = -1 Then Length = UBound(IntBuff) - Startpos
    :
    : For K = Startpos To Startpos + Length
    : IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
    : Next K
    : End Sub
    :
    : Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    : Dim WF As tWAVEFORMATEX
    :
    : WF.wFormatTag = 1 'WAVE_FORMAT_PCM
    : WF.nChannels = 1
    : WF.wBitsPerSample = 16
    : WF.nSamplesPerSec = SamplesPerSec
    :
    : WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) 8
    : WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign
    :
    : Open WaveFileName For Binary Access Write Lock Write As #1
    : WaveWriteHeader 1, WF
    : Put #1, , Buffer
    : WaveWriteHeaderEnd 1
    : Close #1
    : End Sub
    :
    : Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
    : Dim header As FileHeader
    : Dim HdrFormat As WaveFormat
    : Dim chunk As ChunkHeader
    :
    : With header
    : .lRiff = &H46464952 ' "RIFF"
    : .lFileSize = 0
    : .lWave = &H45564157 ' "WAVE"
    : .lFormat = &H20746D66 ' "fmt "
    : .lFormatLength = Len(HdrFormat)
    : End With
    :
    : With HdrFormat
    : .wFormatTag = WaveFmt.wFormatTag
    : .nChannels = WaveFmt.nChannels
    : .nSamplesPerSec = WaveFmt.nSamplesPerSec
    : .nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
    : .nBlockAlign = WaveFmt.nBlockAlign
    : .wBitsPerSample = WaveFmt.wBitsPerSample
    : End With
    :
    : chunk.lType = &H61746164 ' "data"
    : chunk.lLen = 0
    :
    : Put #OutFileNum, 1, header
    : Put #OutFileNum, , HdrFormat
    : Put #OutFileNum, , chunk
    : End Sub
    :
    : Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
    : Dim header As FileHeader
    : Dim HdrFormat As WaveFormat
    : Dim chunk As ChunkHeader
    : Dim Lng As Long
    :
    : Lng = LOF(OutFileNum)
    : Put #OutFileNum, 5, Lng
    :
    : Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
    : Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
    : End Sub
    : ===========
    : ===========
    :

    I don't see your problem... have you tried this code?
    A monotone sounds has two properties: Frequency and Amplitude. This code allows both to be set and changed.
    Looks like a perfect code for your purposes.

    Best Regards,
    Richard

    The way I see it... Well, it's all pretty blurry

  • : : The following code works but won't let me specify exact frequencies, only tones
    : :
    : : This generates a wave file (no clicks or ticks... just clear sound ):
    : : (It makes a 1 second tone of 440 Hz)
    : :
    : : VB Code:
    : :
    : :
    : : Option Explicit
    : :
    : : Private Type tWAVEFORMATEX
    : : wFormatTag As Integer
    : : nChannels As Integer
    : : nSamplesPerSec As Long
    : : nAvgBytesPerSec As Long
    : : nBlockAlign As Integer
    : : wBitsPerSample As Integer
    : : cbSize As Integer
    : : ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
    : : End Type
    : :
    : : Private Type FileHeader
    : : lRiff As Long
    : : lFileSize As Long
    : : lWave As Long
    : : lFormat As Long
    : : lFormatLength As Long
    : : End Type
    : :
    : : Private Type WaveFormat
    : : wFormatTag As Integer
    : : nChannels As Integer
    : : nSamplesPerSec As Long
    : : nAvgBytesPerSec As Long
    : : nBlockAlign As Integer
    : : wBitsPerSample As Integer
    : : End Type
    : :
    : : Private Type ChunkHeader
    : : lType As Long
    : : lLen As Long
    : : End Type
    : :
    : : Private Sub Form_Load()
    : : Dim Buff(0 To 44100) As Integer
    : :
    : : GenerateTone 440, Buff, 1
    : :
    : : SaveWaveFile "C: est_Wave.wav", Buff
    : : End Sub
    : :
    : : Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    : : Dim K As Long, V1 As Double
    : : Const PI As Double = 3.14159265358979
    : :
    : : V1 = SamplesPerSec / (PI * 2 * Frequency)
    : :
    : : If Length = -1 Then Length = UBound(IntBuff) - Startpos
    : :
    : : For K = Startpos To Startpos + Length
    : : IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
    : : Next K
    : : End Sub
    : :
    : : Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    : : Dim WF As tWAVEFORMATEX
    : :
    : : WF.wFormatTag = 1 'WAVE_FORMAT_PCM
    : : WF.nChannels = 1
    : : WF.wBitsPerSample = 16
    : : WF.nSamplesPerSec = SamplesPerSec
    : :
    : : WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) 8
    : : WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign
    : :
    : : Open WaveFileName For Binary Access Write Lock Write As #1
    : : WaveWriteHeader 1, WF
    : : Put #1, , Buffer
    : : WaveWriteHeaderEnd 1
    : : Close #1
    : : End Sub
    : :
    : : Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
    : : Dim header As FileHeader
    : : Dim HdrFormat As WaveFormat
    : : Dim chunk As ChunkHeader
    : :
    : : With header
    : : .lRiff = &H46464952 ' "RIFF"
    : : .lFileSize = 0
    : : .lWave = &H45564157 ' "WAVE"
    : : .lFormat = &H20746D66 ' "fmt "
    : : .lFormatLength = Len(HdrFormat)
    : : End With
    : :
    : : With HdrFormat
    : : .wFormatTag = WaveFmt.wFormatTag
    : : .nChannels = WaveFmt.nChannels
    : : .nSamplesPerSec = WaveFmt.nSamplesPerSec
    : : .nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
    : : .nBlockAlign = WaveFmt.nBlockAlign
    : : .wBitsPerSample = WaveFmt.wBitsPerSample
    : : End With
    : :
    : : chunk.lType = &H61746164 ' "data"
    : : chunk.lLen = 0
    : :
    : : Put #OutFileNum, 1, header
    : : Put #OutFileNum, , HdrFormat
    : : Put #OutFileNum, , chunk
    : : End Sub
    : :
    : : Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
    : : Dim header As FileHeader
    : : Dim HdrFormat As WaveFormat
    : : Dim chunk As ChunkHeader
    : : Dim Lng As Long
    : :
    : : Lng = LOF(OutFileNum)
    : : Put #OutFileNum, 5, Lng
    : :
    : : Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
    : : Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
    : : End Sub
    : : ===========
    : : ===========
    : :
    :
    : I don't see your problem... have you tried this code?
    : A monotone sounds has two properties: Frequency and Amplitude. This
    : code allows both to be set and changed.
    : Looks like a perfect code for your purposes.
    :
    Yeah, I agree. And note that you can pass in non-integer frequencies - in fact, it's desgiend to let you do that (notice: ByVal Frequency As Single).

    So I think this will do the job. It's what I was going to suggest, until I saw it already posted here. :-)

    Jonathan

    ###
    for(74,117,115,116){$::a.=chr};(($_.='qwertyui')&&
    (tr/yuiqwert/her anot/))for($::b);for($::c){$_.=$^X;
    /(p.{2}l)/;$_=$1}$::b=~/(..)$/;print("$::a$::b $::c hack$1.");


  • I forgot to mention that an error occurs when I try to run this code however. The debugger flags these two lines;

    ================
    Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)

    Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    ================

    The error message is "Expected: List Separator or )"

    I haven't been able to figure out why this eror is happening on my end. There does not seem to be any missing list separator or" )"



    : : : ===========
    : : : ===========
    : : :
    : :
    : : I don't see your problem... have you tried this code?
    : : A monotone sounds has two properties: Frequency and Amplitude. This
    : : code allows both to be set and changed.
    : : Looks like a perfect code for your purposes.
    : :
    : Yeah, I agree. And note that you can pass in non-integer frequencies - in fact, it's desgiend to let you do that (notice: ByVal Frequency As Single).
    :
    : So I think this will do the job. It's what I was going to suggest, until I saw it already posted here. :-)
    :
    : Jonathan
    :
    : ###
    : for(74,117,115,116){$::a.=chr};(($_.='qwertyui')&&
    : (tr/yuiqwert/her anot/))for($::b);for($::c){$_.=$^X;
    : /(p.{2}l)/;$_=$1}$::b=~/(..)$/;print("$::a$::b $::c hack$1.");
    :
    :

  • :
    : I forgot to mention that an error occurs when I try to run this code however. The debugger flags these two lines;
    :
    : ================
    : Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    :
    : Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    : ================
    :
    : The error message is "Expected: List Separator or )"
    :
    : I haven't been able to figure out why this eror is happening on my end. There does not seem to be any missing list separator or" )"
    :
    :

    I almost know for sure that it is a problem with Vb4.0 + passing an array (Buffer()). I think you know best how to solve this... I only know Vb6 and a bit of VB.NET.
    However I'm quite sure this is VB6 code.

    As a suggestion, I'd ask: does VB4 allow you to pass an array in a variant type?
    Then you can change Buffer() As Integer to Buffer As Variant, and before calling the function:
    [code]
    'I assume this compiles alright?
    Dim IntBuffer() As Integer
    Dim vBuffer As Variant

    ...
    vBuffer = IntBuffer
    Call SaveWaveFile(..., vBuffer, ...)
    ...
    'Or perhaps even this works (implicit conversion by VB)
    Call SaveWaveFile(..., IntBuffer, ...)
    [/code]
    Again, this is VB6 code so it might be different for you.

    Best Regards,
    Richard

    The way I see it... Well, it's all pretty blurry


  • Your reply was VERY helpful! I was afraid of something like this but was hoping it was not the case. To answer your questions, I just don't know for sure. Which means I better get busy and try out and test the suggestions you have offered. I don't know if it will work but if gives me a reasonable direction to start trying towards.

    Thank you very much! :)

    :
    : I almost know for sure that it is a problem with Vb4.0 + passing an array (Buffer()). I think you know best how to solve this... I only know Vb6 and a bit of VB.NET.
    : However I'm quite sure this is VB6 code.
    :
    : As a suggestion, I'd ask: does VB4 allow you to pass an array in a variant type?
    : Then you can change Buffer() As Integer to Buffer As Variant, and before calling the function:
    : [code]
    : 'I assume this compiles alright?
    : Dim IntBuffer() As Integer
    : Dim vBuffer As Variant
    :
    : ...
    : vBuffer = IntBuffer
    : Call SaveWaveFile(..., vBuffer, ...)
    : ...
    : 'Or perhaps even this works (implicit conversion by VB)
    : Call SaveWaveFile(..., IntBuffer, ...)
    : [/code]
    : Again, this is VB6 code so it might be different for you.
    :
    : Best Regards,
    : Richard
    :
    : The way I see it... Well, it's all pretty blurry
    :
    :


  • ---------

    I needed to be able to create wave sound files with VB 4.0. I received some code that would allow this to be done, but it only
    worked for VB 6.0. With some helpful insight from you and DougT I was able to get it to work in VB 4.0. Am including this code below.

    You and Dougs' "theory" turned out to be right on the nose.

    I took your suggestions and made the changes and 'voila' out came a baked tone cake! Got a wave file that sounded just fine. File size about 87 kb.

    So it looks like this will work just fine as you said right from the beginning.

    It looks like there is still a hitch though. While the sound quality and ability to adjust it is indeed there, I'm still left needing to produce a series of these tones in one wave file. It won't actually work for me unless I can do this, I'll just end up with a whole bunch of really small wave files of one tone each, if you get my drift...

    So the scenario is still, I have a simple text file that contains a variable number of hertz frequencies as numeric decimals, i.e.

    234.7856 Hertz
    432.56
    256.01
    542.1711
    329.8888

    etc.....

    In some text files there may be only a dozen notes, but in some text files there could be hundreds.

    What I intend to do is feed the text file of notes into the routine provided and use the routine to output to a wave file. So I can figure out how to set up my loops (I'm pretty sure), but the 'chunking' stuff is way over my head. Sounds stupid, but its simply the truth. I can grasp what the more complex parts of the code is doing concept wise, but it makes my head swim a little bit. I tried to figure out how to loop this on my own, thought I could loop the generate function, but it blew the stack. Also I could not join the buffs together to make a sequence of tones before writing them all to file.

    So I'm stuck, ironically, with the solution in sight. I can see that the basic premise is sound, but I do not understand how to make it produce a wave file consisting of a series of tones from the input text file. I don't need to be spoon fed, but I also don't grok how to make a series of tones in the wave file..... Am I making sense?


    ==========
    create wav file

    Originally Posted by DougT
    Both model statemets are perfectly OK in VB6 so I would guess that VB4 does not support Optional arguments. You can test the theory by making a few simple changes. (To make it work in VB 4.0)
    Model statements:


    Private Sub GenerateTone(ByVal Frequency As Single, _
    IntBuff() As Integer, _
    Amplitude As Single, _
    SamplesPerSec As Long , _
    Startpos As Long , Length As Long)
    Private Sub SaveWaveFile(ByVal WaveFileName As String, _
    ByRef Buffer() As Integer, _
    SamplesPerSec As Long )


    and change the calling statements to include all the arguments. eg
    Code:

    GenerateTone 261.62, Buff, 1, 44100&, 0&, -1&
    SaveWaveFile "C: est_Wave.wav", Buff, 44100&


    (The '&' after some of the values is to force them to be of type Long)

    --------------------------------------------------------------------------------

    The following is the code for VB 6.0

    The following code lets me specify exact frequencies

    This generates a wave file (no clicks or ticks... just clear sound )
    (It makes a 1 second tone of 440 Hz)


    VB Code


    Option Explicit

    Private Type tWAVEFORMATEX
    wFormatTag As Integer
    nChannels As Integer
    nSamplesPerSec As Long
    nAvgBytesPerSec As Long
    nBlockAlign As Integer
    wBitsPerSample As Integer
    cbSize As Integer
    ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
    End Type

    Private Type FileHeader
    lRiff As Long
    lFileSize As Long
    lWave As Long
    lFormat As Long
    lFormatLength As Long
    End Type

    Private Type WaveFormat
    wFormatTag As Integer
    nChannels As Integer
    nSamplesPerSec As Long
    nAvgBytesPerSec As Long
    nBlockAlign As Integer
    wBitsPerSample As Integer
    End Type

    Private Type ChunkHeader
    lType As Long
    lLen As Long
    End Type

    Private Sub Form_Load()
    Dim Buff(0 To 44100) As Integer

    GenerateTone 440, Buff, 1

    SaveWaveFile "C est_Wave.wav", Buff
    End Sub

    Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    Dim K As Long, V1 As Double
    Const PI As Double = 3.14159265358979

    V1 = SamplesPerSec / (PI * 2 * Frequency)

    If Length = -1 Then Length = UBound(IntBuff) - Startpos

    For K = Startpos To Startpos + Length
    IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
    Next K
    End Sub

    Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    Dim WF As tWAVEFORMATEX

    WF.wFormatTag = 1 'WAVE_FORMAT_PCM
    WF.nChannels = 1
    WF.wBitsPerSample = 16
    WF.nSamplesPerSec = SamplesPerSec

    WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) 8
    WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign

    Open WaveFileName For Binary Access Write Lock Write As #1
    WaveWriteHeader 1, WF
    Put #1, , Buffer
    WaveWriteHeaderEnd 1
    Close #1
    End Sub

    Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
    Dim header As FileHeader
    Dim HdrFormat As WaveFormat
    Dim chunk As ChunkHeader

    With header
    .lRiff = &H46464952 ' "RIFF"
    .lFileSize = 0
    .lWave = &H45564157 ' "WAVE"
    .lFormat = &H20746D66 ' "fmt "
    .lFormatLength = Len(HdrFormat)
    End With

    With HdrFormat
    .wFormatTag = WaveFmt.wFormatTag
    .nChannels = WaveFmt.nChannels
    .nSamplesPerSec = WaveFmt.nSamplesPerSec
    .nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
    .nBlockAlign = WaveFmt.nBlockAlign
    .wBitsPerSample = WaveFmt.wBitsPerSample
    End With

    chunk.lType = &H61746164 ' "data"
    chunk.lLen = 0

    Put #OutFileNum, 1, header
    Put #OutFileNum, , HdrFormat
    Put #OutFileNum, , chunk
    End Sub

    Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
    Dim header As FileHeader
    Dim HdrFormat As WaveFormat
    Dim chunk As ChunkHeader
    Dim Lng As Long

    Lng = LOF(OutFileNum)
    Put #OutFileNum, 5, Lng

    Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
    Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
    End Sub



  • : It looks like there is still a hitch though. While the sound quality and ability to adjust it is indeed there, I'm still left needing to produce a series of these tones in one wave file. It won't actually work for me unless I can do this, I'll just end up with a whole bunch of really small wave files of one tone each, if you get my drift...
    :
    [blue]
    Yeah I knew you'd come with this question if you'd get it working.
    (see comments in color)[/blue]

    : ==========
    : create wav file
    :
    : Originally Posted by DougT
    : Both model statemets are perfectly OK in VB6 so I would guess that VB4 does not support Optional arguments. You can test the theory by making a few simple changes. (To make it work in VB 4.0)
    : Model statements:
    :
    :
    : Private Sub GenerateTone(ByVal Frequency As Single, _
    : IntBuff() As Integer, _
    : Amplitude As Single, _
    : SamplesPerSec As Long , _
    : Startpos As Long , Length As Long)
    : Private Sub SaveWaveFile(ByVal WaveFileName As String, _
    : ByRef Buffer() As Integer, _
    : SamplesPerSec As Long )
    :
    :
    : and change the calling statements to include all the arguments. eg
    : Code:
    :
    : GenerateTone 261.62, Buff, 1, 44100&, 0&, -1&
    : SaveWaveFile "C: est_Wave.wav", Buff, 44100&
    :
    :
    : (The '&' after some of the values is to force them to be of type Long)
    :
    : --------------------------------------------------------------------------------
    :
    : The following is the code for VB 6.0
    :
    : The following code lets me specify exact frequencies
    :
    : This generates a wave file (no clicks or ticks... just clear sound )
    : (It makes a 1 second tone of 440 Hz)
    :
    :
    : VB Code
    :
    :
    : Option Explicit
    :
    : Private Type tWAVEFORMATEX
    : wFormatTag As Integer
    : nChannels As Integer
    : nSamplesPerSec As Long
    : nAvgBytesPerSec As Long
    : nBlockAlign As Integer
    : wBitsPerSample As Integer
    : cbSize As Integer
    : ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
    : End Type
    :
    : Private Type FileHeader
    : lRiff As Long
    : lFileSize As Long
    : lWave As Long
    : lFormat As Long
    : lFormatLength As Long
    : End Type
    :
    : Private Type WaveFormat
    : wFormatTag As Integer
    : nChannels As Integer
    : nSamplesPerSec As Long
    : nAvgBytesPerSec As Long
    : nBlockAlign As Integer
    : wBitsPerSample As Integer
    : End Type
    :
    : Private Type ChunkHeader
    : lType As Long
    : lLen As Long
    : End Type
    :
    : Private Sub Form_Load()
    [green]'Will give a 2 second sounds[/green]
    Dim Buff(0 To [red]88199[/red]) As Integer
    :
    [red]GenerateTone 440, Buff, 1, 44100, 0, 44099
    GenerateTone 2000, Buff, 1, 44100, 44100, 44099[/red]
    [green] 'You might notice the number 44099 = 44100 - 1
    ' and 88199 = 88200 - 1. The first is to account for the
    ' way GenerateTone handles Length. If you say Length = 1 then
    ' it will actually give you 2 samples... so one more than you
    ' specify
    'The second adjustment (88199) is to make the array EXACTLY 2
    ' seconds of music data... because the lower boundary is 0
    ' There are 88199 - 0 + 1 entries = 881200 entries total
    ' and this is our 2 seconds[/green]


    :
    : SaveWaveFile "C est_Wave.wav", Buff
    : End Sub
    :
    : Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    : Dim K As Long, V1 As Double
    : Const PI As Double = 3.14159265358979
    :
    : V1 = SamplesPerSec / (PI * 2 * Frequency)
    :
    : If Length = -1 Then Length = UBound(IntBuff) - Startpos
    :
    : For K = Startpos To Startpos + Length
    : IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
    : Next K
    : End Sub
    :
    : Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    : Dim WF As tWAVEFORMATEX
    :
    : WF.wFormatTag = 1 'WAVE_FORMAT_PCM
    : WF.nChannels = 1
    : WF.wBitsPerSample = 16
    : WF.nSamplesPerSec = SamplesPerSec
    :
    : WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) 8
    : WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign
    :
    : Open WaveFileName For Binary Access Write Lock Write As #1
    : WaveWriteHeader 1, WF
    : Put #1, , Buffer
    : WaveWriteHeaderEnd 1
    : Close #1
    : End Sub
    :
    : Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
    : Dim header As FileHeader
    : Dim HdrFormat As WaveFormat
    : Dim chunk As ChunkHeader
    :
    : With header
    : .lRiff = &H46464952 ' "RIFF"
    : .lFileSize = 0
    : .lWave = &H45564157 ' "WAVE"
    : .lFormat = &H20746D66 ' "fmt "
    : .lFormatLength = Len(HdrFormat)
    : End With
    :
    : With HdrFormat
    : .wFormatTag = WaveFmt.wFormatTag
    : .nChannels = WaveFmt.nChannels
    : .nSamplesPerSec = WaveFmt.nSamplesPerSec
    : .nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
    : .nBlockAlign = WaveFmt.nBlockAlign
    : .wBitsPerSample = WaveFmt.wBitsPerSample
    : End With
    :
    : chunk.lType = &H61746164 ' "data"
    : chunk.lLen = 0
    :
    : Put #OutFileNum, 1, header
    : Put #OutFileNum, , HdrFormat
    : Put #OutFileNum, , chunk
    : End Sub
    :
    : Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
    : Dim header As FileHeader
    : Dim HdrFormat As WaveFormat
    : Dim chunk As ChunkHeader
    : Dim Lng As Long
    :
    : Lng = LOF(OutFileNum)
    : Put #OutFileNum, 5, Lng
    :
    : Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
    : Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
    : End Sub
    :
    :
    :
    :
    [blue]
    And basically this is the way you do it... ofcourse, you're gonna have to think of a function to automate it for you. It'll require some understantion of arrays and how to allocate and reallocate them.[/blue]
    Best Regards,
    Richard

    The way I see it... Well, it's all pretty blurry

  • Hi BITbyBIT!

    Thanks for the reply! I think you added some extra code that wasn't coloured? Had you menat to colour it? I can seem some code lines in colour and other lines in black, but some of the black lines have been changed I think? As for the array stuff, I think I can tackle that.....

    : : It looks like there is still a hitch though. While the sound quality and ability to adjust it is indeed there, I'm still left needing to produce a series of these tones in one wave file. It won't actually work for me unless I can do this, I'll just end up with a whole bunch of really small wave files of one tone each, if you get my drift...
    : :
    : [blue]
    : Yeah I knew you'd come with this question if you'd get it working.
    : (see comments in color)[/blue]
    :
    : : ==========
    : : create wav file
    : :
    : : Originally Posted by DougT
    : : Both model statemets are perfectly OK in VB6 so I would guess that VB4 does not support Optional arguments. You can test the theory by making a few simple changes. (To make it work in VB 4.0)
    : : Model statements:
    : :
    : :
    : : Private Sub GenerateTone(ByVal Frequency As Single, _
    : : IntBuff() As Integer, _
    : : Amplitude As Single, _
    : : SamplesPerSec As Long , _
    : : Startpos As Long , Length As Long)
    : : Private Sub SaveWaveFile(ByVal WaveFileName As String, _
    : : ByRef Buffer() As Integer, _
    : : SamplesPerSec As Long )
    : :
    : :
    : : and change the calling statements to include all the arguments. eg
    : : Code:
    : :
    : : GenerateTone 261.62, Buff, 1, 44100&, 0&, -1&
    : : SaveWaveFile "C: est_Wave.wav", Buff, 44100&
    : :
    : :
    : : (The '&' after some of the values is to force them to be of type Long)
    : :
    : : --------------------------------------------------------------------------------
    : :
    : : The following is the code for VB 6.0
    : :
    : : The following code lets me specify exact frequencies
    : :
    : : This generates a wave file (no clicks or ticks... just clear sound )
    : : (It makes a 1 second tone of 440 Hz)
    : :
    : :
    : : VB Code
    : :
    : :
    : : Option Explicit
    : :
    : : Private Type tWAVEFORMATEX
    : : wFormatTag As Integer
    : : nChannels As Integer
    : : nSamplesPerSec As Long
    : : nAvgBytesPerSec As Long
    : : nBlockAlign As Integer
    : : wBitsPerSample As Integer
    : : cbSize As Integer
    : : ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
    : : End Type
    : :
    : : Private Type FileHeader
    : : lRiff As Long
    : : lFileSize As Long
    : : lWave As Long
    : : lFormat As Long
    : : lFormatLength As Long
    : : End Type
    : :
    : : Private Type WaveFormat
    : : wFormatTag As Integer
    : : nChannels As Integer
    : : nSamplesPerSec As Long
    : : nAvgBytesPerSec As Long
    : : nBlockAlign As Integer
    : : wBitsPerSample As Integer
    : : End Type
    : :
    : : Private Type ChunkHeader
    : : lType As Long
    : : lLen As Long
    : : End Type
    : :
    : : Private Sub Form_Load()
    : [green]'Will give a 2 second sounds[/green]
    : Dim Buff(0 To [red]88199[/red]) As Integer
    : :
    : [red]GenerateTone 440, Buff, 1, 44100, 0, 44099
    : GenerateTone 2000, Buff, 1, 44100, 44100, 44099[/red]
    : [green] 'You might notice the number 44099 = 44100 - 1
    : ' and 88199 = 88200 - 1. The first is to account for the
    : ' way GenerateTone handles Length. If you say Length = 1 then
    : ' it will actually give you 2 samples... so one more than you
    : ' specify
    : 'The second adjustment (88199) is to make the array EXACTLY 2
    : ' seconds of music data... because the lower boundary is 0
    : ' There are 88199 - 0 + 1 entries = 881200 entries total
    : ' and this is our 2 seconds[/green]
    :
    :
    : :
    : : SaveWaveFile "C est_Wave.wav", Buff
    : : End Sub
    : :
    : : Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
    : : Dim K As Long, V1 As Double
    : : Const PI As Double = 3.14159265358979
    : :
    : : V1 = SamplesPerSec / (PI * 2 * Frequency)
    : :
    : : If Length = -1 Then Length = UBound(IntBuff) - Startpos
    : :
    : : For K = Startpos To Startpos + Length
    : : IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
    : : Next K
    : : End Sub
    : :
    : : Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
    : : Dim WF As tWAVEFORMATEX
    : :
    : : WF.wFormatTag = 1 'WAVE_FORMAT_PCM
    : : WF.nChannels = 1
    : : WF.wBitsPerSample = 16
    : : WF.nSamplesPerSec = SamplesPerSec
    : :
    : : WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) 8
    : : WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign
    : :
    : : Open WaveFileName For Binary Access Write Lock Write As #1
    : : WaveWriteHeader 1, WF
    : : Put #1, , Buffer
    : : WaveWriteHeaderEnd 1
    : : Close #1
    : : End Sub
    : :
    : : Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
    : : Dim header As FileHeader
    : : Dim HdrFormat As WaveFormat
    : : Dim chunk As ChunkHeader
    : :
    : : With header
    : : .lRiff = &H46464952 ' "RIFF"
    : : .lFileSize = 0
    : : .lWave = &H45564157 ' "WAVE"
    : : .lFormat = &H20746D66 ' "fmt "
    : : .lFormatLength = Len(HdrFormat)
    : : End With
    : :
    : : With HdrFormat
    : : .wFormatTag = WaveFmt.wFormatTag
    : : .nChannels = WaveFmt.nChannels
    : : .nSamplesPerSec = WaveFmt.nSamplesPerSec
    : : .nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
    : : .nBlockAlign = WaveFmt.nBlockAlign
    : : .wBitsPerSample = WaveFmt.wBitsPerSample
    : : End With
    : :
    : : chunk.lType = &H61746164 ' "data"
    : : chunk.lLen = 0
    : :
    : : Put #OutFileNum, 1, header
    : : Put #OutFileNum, , HdrFormat
    : : Put #OutFileNum, , chunk
    : : End Sub
    : :
    : : Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
    : : Dim header As FileHeader
    : : Dim HdrFormat As WaveFormat
    : : Dim chunk As ChunkHeader
    : : Dim Lng As Long
    : :
    : : Lng = LOF(OutFileNum)
    : : Put #OutFileNum, 5, Lng
    : :
    : : Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
    : : Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
    : : End Sub
    : :
    : :
    : :
    : :
    : [blue]
    : And basically this is the way you do it... ofcourse, you're gonna have to think of a function to automate it for you. It'll require some understantion of arrays and how to allocate and reallocate them.[/blue]
    : Best Regards,
    : Richard
    :
    : The way I see it... Well, it's all pretty blurry
    :
    :


  • Am wondering how you feel the following code might integrate and work with the code samples you provided; ???

    (Also, were there lines in the last code section you sent that were meant to be coloured? I dont think they all came through?)
    ============


    Code by CVMICHAEL

    Private Sub Form_Load()
    Dim Buff(0 To 44100 * 10) As Integer ' make a 10 seconds buffer
    Dim StartPos As Long, Length As Long
    Dim FreqList As Variant, K As Long

    ' get the frequency list
    FreqList = Array(234.7856, 432.56, 256.01, 542.1711, 329.8888, 800, 1000, 2000, 4000, 6000, 8000, 10000)

    ' start from the beginning
    StartPos = 0
    ' calculate length by dividing our buffer by the total # of frequencies
    Length = UBound(Buff) / (UBound(FreqList) + 1)

    For K = 0 To UBound(FreqList)
    GenerateTone FreqList(K), Buff, 1, 44100, StartPos, Length

    ' next time start from the end of current frequency
    StartPos = StartPos + Length
    Next K

    SaveWaveFile "C: est_Wave.wav", Buff
  • :
    : Am wondering how you feel the following code might integrate and work with the code samples you provided; ???
    :
    : (Also, were there lines in the last code section you sent that were meant to be coloured? I dont think they all came through?)

    In reply to both your posts: the color worked on my browser.
    All the lines I modified/added were in color. If you do not see these colors, click the Reply button to that post and find the [leftbr]red[rightbr] and [leftbr]green[rightbr] tags.


    : ============
    :
    :
    : Code by CVMICHAEL
    :
    : Private Sub Form_Load()
    : Dim Buff(0 To 44100 * 10) As Integer ' make a 10 seconds buffer
    : Dim StartPos As Long, Length As Long
    : Dim FreqList As Variant, K As Long
    :
    : ' get the frequency list
    : FreqList = Array(234.7856, 432.56, 256.01, 542.1711, 329.8888, 800, 1000, 2000, 4000, 6000, 8000, 10000)
    :
    : ' start from the beginning
    : StartPos = 0
    : ' calculate length by dividing our buffer by the total # of frequencies
    : Length = UBound(Buff) / (UBound(FreqList) + 1)
    :
    : For K = 0 To UBound(FreqList)
    : GenerateTone FreqList(K), Buff, 1, 44100, StartPos, Length
    :
    : ' next time start from the end of current frequency
    : StartPos = StartPos + Length
    : Next K
    :
    : SaveWaveFile "C: est_Wave.wav", Buff
    :

    Yeah looks good to me. In this situation, each sound frequency lasts for 10/12 th of a second. And the entire stream is 10 + 1/44100 seconds.

    Best Regards,
    Richard

    The way I see it... Well, it's all pretty blurry

  • Ok, so I followed your advice and made MUCH progress. In fact I think I'm almost done, everything seems to be working ok except for one glitch somewhere.

    I created a text file for testing called "frequency.txt"

    its contents being;

    432.8876
    1234.999
    1080.977
    256.4444

    I made some simple modifications to the code, to allow for the extraction
    of each line of frequency numbers from the text file and then the storage
    of each value to an array element. I placed commas (remmed) some of the lines in the previous code out and made modifactions to allow for this.

    When I tried to run the code in function; Private Sub GenerateTone

    at line
    V1 = SamplesPerSec / (PI * 2 * Frequency)

    Error produced;

    "Run-time error '11'

    Division by zero"


    I thought I probably just assigned the wrong value type to my added lines, but have tried Long, Double, Int, etc.... and this doesn't seem to make any
    difference.

    Any idea where I'm missing the hoop? The code strings are below;


    ============

    Private Sub Command1_Click()
    'Dim Buff(0 To 44100) As Integer
    'GenerateTone 432, Buff, 1, 44100, 0&, -1&
    'SaveWaveFile "C: est_Wave.wav", Buff, 44100


    'open text file, read first value as number of freqs in file, let this value be " X "
    'create an array with " X " number of elements

    'create do loop with counter that stops at " X + 1 " values
    'go to second line of text file, read complete line as first value, dump into temp variable
    'dump temp variable into first array element
    'increment array element position by one (move to next array position)
    'increment do while counter by one
    'loop until array is populate by all values in text file
    'exit loop and close text file
    '====================
    '============= COUNTS THE NUMBER OF FREQUENCIES IN A GIVEN TEXT FILE ===========================

    Dim textline 'temp variable input data is dumped to
    Dim assess_number_of_frequencies
    Dim freq_array_element As Double

    assess_number_of_frequencies = 0

    Open "c:frequency.txt" For Input As #1 ' Open file.
    Do While Not EOF(1) ' Loop until end of file.
    assess_number_of_frequencies = ssess_number_of_frequencies + 1
    Line Input #1, textline ' Read line into variable.
    Debug.Print textline ' Print to Debug window.
    Loop
    Close #1 ' Close file.

    Debug.Print assess_number_of_frequencies
    ' Print to Debug window.

    freq_array_element = 0
    ReDim FreqList(assess_number_of_frequencies)
    '==================
    Dim freq_input
    freq_input = 0
    '========= POPULATE ARRAY WITH FREQUENCIES ==============


    Open "c:frequency.txt" For Input As #1 ' Open file.
    Do While Not EOF(1) ' Loop until end of file.
    Line Input #1, freq_input ' Read line into variable.
    FreqList(freq_array_element) = CLng(freq_input)
    'assign freq from text file to array element

    freq_array_element = freq_array_element + 1
    ' increment array element to get ready to accept next frequency
    Debug.Print freq_input ' Print to Debug window.
    freq_input = 0 'reset temp var to zero
    Loop
    Close #1 ' Close file.

    freq_array_element = 0
    'position array element pointer back to zero so its on the first frequency
    '==========
    '=========
    Dim Buff(0 To 44100 * 10) As Integer ' make a 10 seconds buffer
    Dim StartPos As Long, Length As Long
    ' Dim FreqList As Variant, K As Long
    Dim K As Long 'added by me

    ' get the frequency list
    ' FreqList = Array(234.7856, 432.56, 256.01, 542.1711, 329.8888, 800, 1000, 2000, 4000, 6000, 8000, 10000)

    ' start from the beginning
    StartPos = 0
    ' calculate length by dividing our buffer by the total # of frequencies
    Length = UBound(Buff) / (UBound(FreqList) + 1)

    Debug.Print "Length ;"; Length


    For K = 0 To UBound(FreqList)
    GenerateTone FreqList(K), Buff, 1, 44100, StartPos, Length

    ' next time start from the end of current frequency
    StartPos = StartPos + Length
    Next K

    SaveWaveFile "C: est_Wave.wav", Buff, 44100

    End Sub
    -------------------------


    Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Amplitude As Single, SamplesPerSec As Long, StartPos As Long, Length As Long)



    Dim K As Long, V1 As Double
    Const PI As Double = 3.14159265358979

    V1 = SamplesPerSec / (PI * 2 * Frequency)

    If Length = -1 Then Length = UBound(IntBuff) - StartPos

    For K = StartPos To StartPos + Length
    IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))

    ' Debug.Print IntBuff(K)

    Next K

    End Sub

    ' Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)

  • Does VB4 have a step-by-step debugger?

    Best thing to do is set a breakpoint on Command1_Click and run through the code. Check if the right values are loaded from the file and if any unexpected things happen.

    PS: You should use [leftbr]code[rightbr][leftbr]/code[rightbr] tags to post code. It'll save the formatting which is nicer for reading.
    Example:
    [code]
    Function xyz() As Boolean
    Dim x As Integer

    For x = 1 To 2
    xyz = Not xyz
    Next
    End Function
    [/code]
    Is created by:
    [leftbr]code[rightbr]
    Function xyz() As Boolean
    Dim x As Integer

    For x = 1 To 2
    xyz = Not xyz
    Next
    End Function
    [leftbr]/code[rightbr]

    If you don't have a debugger, I could take another look, but I suspect something does wrong with getting the values from the text file.

    Best Regards,
    Richard

    The way I see it... Well, it's all pretty blurry

Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories