Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

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

Re: The Beep Function.

Show all headers | View raw

On Jan 5, 2:13 pm, "Mike Williams" <M...@WhiskyAndCoke.com> wrote:
> "Peter Nolan" <peter.nola...@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


Hello Mike,

I want to thank you for the two fandabadozi blocks of code you have
sent me. I'm indebted to you. I will now implement the code and study
it till I understand what each line actually does. I'm a physicist by
profession so the technical or mathematical aspects of the code to do
with sine functions is readily understandable to me in addition to my
being able to understand A/D to conversion and it's converse D/A
conversion so you will be happy to know that while I'm not an ace
coder like you are I am not totally clueless about what is going on
here either. :)
I want to tell you what I'm trying to do. I have mild depression as
distinct from clinical depression and while mild depression isn't too
serious it is nevertheless debilitating enough and I earnestly wish
that I had an overall brighter outlook on life. This is a bit of a
long story but because I've probably lost you already having just told
you what I have and so I won't go into all the ins and outs of how I
imagine I thought I have might have a possible treatment for mild
depression especially and probably only in the case of reactive
depression as distinct from indigenous depression that is caused by
real physical upset to the brain/body system because it's always so
important to factor in that component that is the body part or role
played by the whole body.
Many years ago, me thinking I don't want to lose you in all this, I
heard that depression is anger turned inwards. I think this is a
brilliant insight. Now, Mike, imagine looking at the computer screen
as you are doing now but imagine never being able to change that
perspective. Imagine having that fixed outlook that is staring forever
at a computer screen and never be able to switch off the screen and
oneself and say to then enjoy everything else that is going on around
one in life noting the phrase "around one". That is a sort of away to
think about depression that is to be forever fixed in one's outlook
peering straight ahead never being able to take the more panoramic
viewpoint that any normal person should be able to hold during the
very varied day that it's possible for many to live.
Now take all that into account and consider the possibility that it
might be possible to induce in someone suffering from depression that
feeling of being able to look around one three hundred and sixty
degree style.
So this is my idea. Years ago 2001 I designed and built a little
pacemaker for runners that simply emits a beep at some settable rate
according to how fast the runner wants to run. Don't get the wrong
idea that I am a whizz electronic design engineer like the fellas in
the newsgroup sci.design.electronics Some of those guys are just
amazing just like you are at coding. Just amazing! I had high hopes to
make some money here but it all came to nothing when it turns out a
company called Garmin make such a device using GPS and simply worn on
the wrist. No way could I compete with them.
However during the last week or two because this project of mine is
only in it's infancy I would sit there comfortably and place the
beeping pacemaker behind my back behind where I'm sitting in the chair
close my eyes and try to focus entirely on the beep beeping at a rate
of about one beep per second. I gotta say I really have noticed a
difference in how I feel even after only say six sessions with each
session lasting say half an hour. You see now immediately why I wanted
the PC to do all this that that little hardware based beeper does. I
got really excited about being able to just choose at will any
frequency for the beep in the PC's speakers and so on and I'll bet you
can relate to how disappointed I felt when it didn't work on my PC.
So I'm trying to train my mind to have a broader outlook by for
example just sitting there for half an hour each day listening to a
beep being emitted right there, not in front of me where my focus
always is, but behind my back. I don't blame you if this doesn't make
the slightest bit of sense to you as a guy who is exceedingly bright
but maybe I'm onto something here that might just give relief. When I
implement the code on my PC I will be able to see much more clearly
any potential this very novel approach might have. I think at least
that this is worth exploring and if it doesn't work and I think it
might already have done just that I will only have lost a bit of time
and I will have made contact with a fantastic coder called Mike
Williams and that's a good thing. That's a great thing.
It will take me a little time to implement the code so please bear
with me. I will let you know how things pan out through
comp.lang.basic.visual.misc.
With regard to posting to NG's I can tell you I use a Mac iBook and I
was able to use MT-Newswatcher on this machine. However there was a
hiccup of some sort when I tried to post to this NG this time round
and so I had to go through google. If spam starts coming in I
discovered I can just delete the gmail address and so long as no one
knows my other email address from my ISP all should be well.

Best Wishes,

Peter Nolan. Ph.D.
33 Templeville Rd.
Templeogue
Dublin 6W

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