Option Explicit
Dim SoundEnd As Boolean
'If you wish, put this declarations on a
' module, deleting "Private"
'Write a byte to port:


Private Declare Sub vbOut Lib "WIN95IO.DLL" (ByVal nPort As Integer, ByVal nData As Integer)
'Read a byte from port:


Private Declare Function vbInp Lib "WIN95IO.DLL" (ByVal nPort As Integer) As Integer
'These are standard freqs of music. You
' can set any freq.
Const C = 523 'Do In spanish
Const D = 587.33 'Re
Const E = 659.26 'Mi
Const F = 698.46 'Fa
Const G = 783.99 'Sol
Const A = 880 'La
Const B = 987.77 'Si


Private Sub cmdStartSound_Click()
Dim i As Integer
'This is all you have to do to simulate
' a phone ring sound.


For i = 1 To 12
Sounds C, 20 'Sounds 523 Hz In 20 miliseconds
Sounds F, 20 'Sounds 698.46 Hz In 20 miliseconds
Next i
'Need to go up an octave? Just double th
' e frequency or viceversa.
' example:
'Sounds C * 2, 500'An octave up
'Sounds C / 2, 500'An octave down
'Yes, you can do a funny piano using you
' r programming skills !
End Sub


Private Sub Sounds(Freq, Length)
Dim LoByte As Integer
Dim HiByte As Integer
Dim Clicks As Integer
Dim SpkrOn As Integer
Dim SpkrOff As Integer
'"I didn't tested if this is exactly the
' frequency,
'but it's ok to start here. I you wish m
' ore precision,
'try with a piano or another reference t
' o adjust the clicks.
'For example, "A" has a frequency of 880
' Hertz. If you have
'a good ear, it may be adjusted very clo
' se by
'changing the 1193280 number up or down.
'
'Of course, you can use a frequency mete
' r.
'I didn't tested the frequency limits to
' o. Test it by yourself."
'Length precision is the same as the tim
' er control precision.
'Ports 66, 67, and 97 control timer and
' speaker
'Divide clock frequency by sound frequen
' cy
'to get number of "clicks" clock must pr
' oduce.
Clicks = CInt(1193280 / Freq)
LoByte = Clicks And &HFF
HiByte = Clicks \ 256
'Tell timer that data is coming
vbOut 67, 182
'Send count to timer
vbOut 66, LoByte
vbOut 66, HiByte
'Turn speaker on by setting bits 0 and 1
' of PPI chip.
SpkrOn = vbInp(97) Or &H3
vbOut 97, SpkrOn 'My speaker is sounding !
'Leave speaker on (while timer runs)
SoundEnd = False 'Do Not finish yet
TimerSound.Interval = Length 'Time To sound
TimerSound.Enabled = True 'Begin To count time


Do While Not SoundEnd
'Let processor do other tasks


DoEvents
Loop
'Turn speaker off resetting bit 0 and 1.
'
SpkrOff = vbInp(97) And &HFC
vbOut 97, SpkrOff
End Sub


Private Sub TimerSound_Timer()
'Time is over
SoundEnd = True 'Finish sound now
TimerSound.Enabled = False
End Sub