Groups > comp.lang.basic.visual.misc > #602

Re: The Beep Function.

Path	csiph.com!x330-a1.tempe.blueboxinc.net!usenet.pasdenom.info!weretis.net!feeder4.news.weretis.net!eternal-september.org!feeder.eternal-september.org!mx04.eternal-september.org!.POSTED!not-for-mail
From	"Mike Williams" <Mike@WhiskyAndCoke.com>
Newsgroups	comp.lang.basic.visual.misc
Subject	Re: The Beep Function.
Date	Thu, 5 Jan 2012 14:13:17 -0000
Organization	A noiseless patient Spider
Lines	127
Message-ID	<je4b50$jf3$1@dont-email.me> (permalink)
References	<491f49f4-a678-4420-b0e4-935b398adc7b@a40g2000vbu.googlegroups.com> <je1tvg$hot$1@dont-email.me> <7b72a5b5-5662-4632-b3b9-9f45a985c9fd@z12g2000yqm.googlegroups.com>
Mime-Version	1.0
Content-Type	text/plain; format=flowed; charset="iso-8859-1"; reply-type=original
Content-Transfer-Encoding	7bit
Injection-Date	Thu, 5 Jan 2012 14:12:48 +0000 (UTC)
Injection-Info	mx04.eternal-september.org; posting-host="CZKYexsZ91tHDdhgm9pJtw"; logging-data="19939"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX184vLt4ltBmMtdvi85JN/2Dh1UWxLztgAQ="
In-Reply-To	<7b72a5b5-5662-4632-b3b9-9f45a985c9fd@z12g2000yqm.googlegroups.com>
X-Newsreader	Microsoft Windows Mail 6.0.6002.18197
Cancel-Lock	sha1:dJRt0THTya0O4/0tUDajgQHp4jo=
X-Priority	3
X-MSMail-Priority	Normal
X-MIMEOLE	Produced By Microsoft MimeOLE V6.0.6002.18463
Xref	x330-a1.tempe.blueboxinc.net comp.lang.basic.visual.misc:602

Show key headers only | View raw

"Peter Nolan" <peter.nolan40@gmail.com> wrote in message 
news:7b72a5b5-5662-4632-b3b9-9f45a985c9fd@z12g2000yqm.googlegroups.com...

> If you can help out a little more that would be great . . .

Here's another slightly different example in which I've used an Integer 
array instead of a String and where I am generating the entire required 
length of wav file data rather than generating a small 0.1 second wav and 
playing it in a timed loop as did my previous example. This version will of 
course allow you to then save the full length wav file to disk if you wish 
to do so (see remarks in the code). Paste the code into a VB Form containing 
a Command Button.

Mike

Option Explicit
Private Declare Function PlaySoundFromBytes _
    Lib "winmm.dll" Alias "PlaySoundA" _
    (lpBytes As Any, ByVal hModule As Long, _
    ByVal dwFlags As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (Destination As Any, _
    Source As Any, ByVal Length As Long)
Private Const SND_ASYNC As Long = &H1
Private Const SND_MEMORY As Long = &H4
Private Const SND_NODEFAULT As Long = &H2
Private Const SND_SYNC As Long = &H0
Private Const SND_PURGE = &H40

Private Sub WavBeep(Frequency As Long, _
  Duration As Double, Optional wait As Boolean = False)
Static wavfile() As Integer, Flags As Long
Dim SamplesPerSec As Double, samplerate As Double
Dim cycles As Double, pi As Double, k As Double
Dim n As Long, totalsamples As Long, d1 As Long
Dim Amplitude As Integer, dAngle As Double
SamplesPerSec = 44100
Amplitude = 32600 ' just under full volume
Duration = Duration / 1000 ' change to seconds
cycles = Round(Frequency * Duration)
If cycles < 1 Then cycles = 1
totalsamples = Round(SamplesPerSec / Frequency * cycles)
  ' Note: we may need to add padding bytes to make
  ' actual wav data a multiple of 4, which means for
  ' some 16 bit (2 byte) wav we may need and extra
  ' 2 bytes if totalsamples is an odd number
  ' (Actually on subsequent checking it appears this
  ' is not necessary as long as the data is a whole
  ' number of Integers, which of course it always will
  ' be at 16 bits per sample, but I may need to check
  ' this out further).
ReDim wavfile(1 To totalsamples + 22) ' 44 Bytes for header
wavfile(1) = &H4952 ' ) "RIFF"
wavfile(2) = &H4646 ' )
  ' calculate byte len of total wav file minus 8 bytes
d1 = (totalsamples + 22) * 2 - 8
  ' and copy the Long result into the two Integers
CopyMemory wavfile(3), d1, 4
wavfile(5) = &H4157 ' ) "WAVE"
wavfile(6) = &H4556 ' )
wavfile(7) = &H6D66 ' ) "fmt "
wavfile(8) = &H2074
d1 = 16 ' chunk size (Long)
CopyMemory wavfile(9), d1, 4 ' write Long to 2 Integers
wavfile(11) = 1 ' 1 = not compressed
wavfile(12) = 1 ' number of channels (1 for mono)
d1 = SamplesPerSec
CopyMemory wavfile(13), d1, 4
  ' calculate average bytes per second
  ' (16 bit mono = samplespersec * 2) (Long)
d1 = SamplesPerSec * 2
CopyMemory wavfile(15), d1, 4
  ' blockalign (bytes per sample frame)
  ' (16 bit mono = 2) (Integer)
wavfile(17) = 2
wavfile(18) = 16 ' 16 bits per sample
wavfile(19) = &H6164 ' ) "DATA"
wavfile(20) = &H6174 ' )
d1 = totalsamples * 2
  ' actual wav data bytes not counting header or padding
CopyMemory wavfile(21), d1, 4
  ' generate the actual sine wave data
pi = Atn(1) * 4
dAngle = (cycles * 2 * pi) / totalsamples
For n = 0 To totalsamples - 1
d1 = Amplitude * Sin(k)
    wavfile(n + 23) = d1
    k = k + dAngle
Next n
Flags = SND_MEMORY Or SND_NODEFAULT
If wait = True Then
  Flags = Flags Or SND_SYNC
Else
  Flags = Flags Or SND_ASYNC
End If
PlaySoundFromBytes wavfile(1), ByVal 0&, Flags
' Use the following commented out block of code
' as an example if you wish to save the wav file
' to disk as a standard .wav file
'Dim s1 As String, fn As Long
's1 = "c:\temp\testwav1.wav"
'fn = FreeFile
'Open s1 For Output As fn
'Close fn
'Open s1 For Binary As fn
'Put fn, 1, wavfile()
'Close 1
End Sub

Private Sub Command1_Click()
WavBeep 400, 500 ' 400 Hz for 500 milliseconds
End Sub

Private Sub Command2_Click()
' stop wav playing (most useful for stopping
' a wav that is being played using SND_LOOP
PlaySoundFromBytes ByVal 0&, ByVal 0&, _
    SND_PURGE Or SND_NODEFAULT
End Sub

Private Sub Form_Unload(Cancel As Integer)
PlaySoundFromBytes ByVal 0&, ByVal 0&, _
    SND_PURGE Or SND_NODEFAULT
End Sub

Back to comp.lang.basic.visual.misc | Previous | Next — Previous in thread | Next in thread | Find similar

Thread

The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-04 06:15 -0800
  Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-04 07:11 -0800
  Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-04 15:38 +0000
  Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-04 16:16 +0000
    Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-04 10:15 -0800
      Re: The Beep Function. Jim Mack <no-uce-ube@mdxi.com> - 2012-01-04 13:46 -0500
        Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-05 08:09 -0800
      Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-04 22:24 +0000
      Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-05 08:22 +0000
      Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-05 09:21 +0000
        Re: The Beep Function. Gordon Levi <gordon@address.invalid> - 2012-01-05 21:54 +1100
          Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-05 11:33 +0000
            Re: The Beep Function. Gordon Levi <gordon@address.invalid> - 2012-01-06 00:20 +1100
              Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-05 17:46 +0000
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-06 14:03 +1100
                Re: The Beep Function. Gordon Levi <gordon@address.invalid> - 2012-01-08 00:43 +1100
                Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-07 20:53 +0000
                Re: The Beep Function. Gordon Levi <gordon@address.invalid> - 2012-01-08 17:27 +1100
                Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-08 09:49 +0000
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-08 08:00 +1100
                Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-07 22:43 +0000
      Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-05 14:13 +0000
        Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-05 08:26 -0800
        Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-05 08:04 -0800
        Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-07 04:41 -0800
          Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-08 11:19 +0000
        Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-10 04:52 -0800
          Re: The Beep Function. "Thorsten Albers" <gudea@gmx.de> - 2012-01-10 13:01 +0000
          Re: The Beep Function. Jim Mack <no-uce-ube@mdxi.com> - 2012-01-10 11:44 -0500
            Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-11 05:58 -0800
          Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-10 17:19 +0000
            Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-11 05:54 -0800
              Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-11 15:21 +0000
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-12 08:04 -0800
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-13 12:40 +1100
                Re: The Beep Function. ralph <nt_consulting64@yahoo.net> - 2012-01-12 21:28 -0600
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-13 15:34 +1100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-13 05:25 -0800
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-14 07:32 +1100
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-13 11:06 +0000
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-13 05:48 -0800
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-13 15:09 +0000
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-14 04:29 -0800
                Re: The Beep Function. Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-01-14 14:56 +0100
                Re: The Beep Function. ralph <nt_consulting64@yahoo.net> - 2012-01-14 10:24 -0600
                Re: The Beep Function. Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-01-14 18:51 +0100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-15 03:39 -0800
                Re: The Beep Function. Schmidt <sss@online.de> - 2012-01-15 17:39 +0100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-16 05:21 -0800
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-16 14:39 +0000
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-17 04:13 -0800
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-17 14:17 +0000
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-17 07:22 -0800
                Re: The Beep Function. "Henning" <computer_hero@coldmail.com> - 2012-01-17 17:47 +0100
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-17 16:50 +0000
                Re: The Beep Function. "Henning" <computer_hero@coldmail.com> - 2012-01-17 18:22 +0100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-18 05:26 -0800
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-18 14:35 +0000
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-18 07:10 -0800
                Re: The Beep Function. ralph <nt_consulting64@yahoo.net> - 2012-01-18 10:38 -0600
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-19 05:42 +1100
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-19 11:33 +0000
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-21 03:16 -0800
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-19 05:17 -0800
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-20 05:17 +1100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-20 03:54 -0800
                Re: The Beep Function. Jason Keats <jkeats@melbpcDeleteThis.org.au> - 2012-01-20 23:40 +1100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-21 03:20 -0800
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-21 15:20 +1100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-21 03:23 -0800
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-20 05:11 +1100
                Re: The Beep Function. Schmidt <sss@online.de> - 2012-01-17 18:58 +0100
                Re: The Beep Function. Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-01-17 23:13 +0100
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-18 09:12 +0000
                Re: The Beep Function. "DaveO" <djo@dial.pipex.com> - 2012-01-18 09:22 +0000
                Re: The Beep Function. ralph <nt_consulting64@yahoo.net> - 2012-01-18 05:39 -0600
                Re: The Beep Function. Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-01-18 13:32 +0100
                Re: The Beep Function. ralph <nt_consulting64@yahoo.net> - 2012-01-15 13:30 -0600
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-16 06:59 +1100
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-16 06:55 +1100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-16 06:06 -0800
                Re: The Beep Function. "Mike Williams" <Mike@WhiskyAndCoke.com> - 2012-01-13 22:34 +0000
                Re: The Beep Function. "blank" <blank@blankety.blank.com> - 2012-01-14 19:50 +1100
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-14 05:10 -0800
                Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-14 06:16 -0800
  Re: The Beep Function. "Henning" <computer_hero@coldmail.com> - 2012-01-19 20:25 +0100
    Re: The Beep Function. Peter Nolan <peter.nolan40@gmail.com> - 2012-01-20 03:56 -0800

csiph-web