Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Wanet Telecoms Ltd on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

how to make tone generation

Status
Not open for further replies.

kd7yen

Programmer
Sep 22, 2003
38
US
i need to no how to make a tone like 1500Hz to be outputed for a certain length when the left mouse button is clicked and a shorter length when the right button is pressed. this is to make the dots and dashes for CW (MOROSE CODE).

-.- -.. --... -.-- . -.
(kd7yen)
 
Copy this code in your form

Option Explicit

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim tone
Select Case Button
Case 1
tone = Beep(1500, 250)
Case 2
tone = Beep(1500, 500)
End Select
End Sub


copy this code in a module
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long


For your information:
This function will be good with all windows versions exeptionally with Win 95 or 98

peterguhl@yahoo.de
 
you have been probably the best thing that has happened to me all day God bless you!!!
 
thank you for you help in this matter but i have to make one that generates the tones as you put them into the keyboard example

"k" would be "long, short, long" or "-.-"
so on and so on


i have the code for a program that does this but it is written in basic and i want to have it in VB
 
In the Keypress event just add a Select Case statement:

Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 97 'a
call short
call quiet
call longer
call quiet
Case 98 'b
call longer
call quiet
call short
call quiet
call short
call quiet
call short
call quiet
Case 99 'c
' etc etc

Case Else
KeyAscii = 0
Beep
End Select
End Sub

Sub Short
tone = Beep(1500, 250)
End Sub

Sub Longer
tone = Beep(1500, 500)
End Sub

Sub Quiet
' use sleep api or whatever for 250 msec wait
End sub

This isn't finished code! But it should give you the idea

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'People who live in windowed environments shouldn't cast pointers.'
 
eesh! surely theres a formula here!

as a morse code novice (i know SOS (...---...)... lol!)

how is morse "worked out"

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383
 
hmmm and the second i posted i googled!!


there is no pattern.... or is there????

i also note the lines

"If the duration of a dot is taken to be one unit then that of a dash is three units. The space between the components of one character is one unit, between characters is three units and between words seven units. To indicate that a mistake has been made and for the receiver to delete the last word send ........ (eight dots)."

hmmm...!

good luck!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383
 
hehe... Arbitrarily (according to word [sorry couple of bevvys... needed to check the synonyms])

so its completely random!! (well in the sense it has [i presume] the most comonly used letters are the shortest ( ie . , - , .- , -. etc)

ill be back! (unless the shut eye beats me)

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383
 
ok im beat for the night! i wrote a big enum but it wouldnt work! i think my theory is right but the implimentation is lacking at this hour! ill try again tomorrow!! [wink]

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383
 
jenkies... i was sooo close, i just changed to using a lookup table and it works... hoorah!!

its not perfect (well if it is ill be impressed cos i only done about 3 minutes testing on it!!! [lol])

Code:
Private Declare Function Beep Lib "kernel32" ( _
    ByVal dwFreq As Long, _
    ByVal dwDuration As Long _
) As Long

Private Declare Sub Sleep Lib "kernel32" ( _
    ByVal dwMilliseconds As Long _
)

Dim LookUp(45) As String

Const FREQ As Long = 1500
Const UNIT As Long = 250

Private Sub Form_Load()
    
    'alpha
    LookUp(0) = "./-"
    LookUp(1) = "-/././."
    LookUp(2) = "-/./-/."
    LookUp(3) = "-/./."
    LookUp(4) = "."
    LookUp(5) = "././-/."
    LookUp(6) = "-/-/."
    LookUp(7) = "./././."
    LookUp(8) = "../."
    LookUp(9) = "./-/-/-"
    LookUp(10) = "-/./-"
    LookUp(11) = "./-/./."
    LookUp(12) = "-/-"
    LookUp(13) = "-/."
    LookUp(14) = "-/-/-"
    LookUp(15) = "./-/-/."
    LookUp(16) = "-/-/./-"
    LookUp(17) = "./-/."
    LookUp(18) = "././."
    LookUp(19) = "-"
    LookUp(20) = "././-"
    LookUp(21) = "./././-"
    LookUp(22) = "./-/-"
    LookUp(23) = "-/././-"
    LookUp(24) = "-/./-/-"
    LookUp(25) = "-/-/./."
    
    'numeric
    LookUp(26) = "-/-/-/-/-"
    LookUp(27) = "./-/-/-/-"
    LookUp(28) = "././-/-/-"
    LookUp(29) = "./././-/-"
    LookUp(30) = "././././-"
    LookUp(31) = "././././."
    LookUp(32) = "-/./././."
    LookUp(33) = "-/-/././."
    LookUp(34) = "-/-/-/./."
    LookUp(35) = "-/-/-/-/."
    
    'special
    LookUp(36) = "./-/././-/."  '34 quotation mark
    
    LookUp(37) = "./-/-/-/-/."  '39 apostrophe
    LookUp(38) = "-/./-/-/./-"  '40 and 41 parenthasis
    
    LookUp(39) = "-/-/././-/-"  '44 comma
    LookUp(40) = "-/././././-"  '45 hyphen
    LookUp(41) = "./-/./-/./-"  '46 full stop
    LookUp(42) = "-/././-/."    '47 fraction bar
    
    LookUp(43) = "-/-/-/././."  '58 colon
    
    LookUp(44) = "././-/-/./."  '63 question mark
    
    'other
    LookUp(45) = "./././././././." 'delete last word
    
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    
    If KeyAscii >= 97 And KeyAscii <= 122 Then
        BeepMe LookUp(KeyAscii - 97)
    ElseIf KeyAscii >= 48 And KeyAscii <= 57 Then
        BeepMe LookUp(KeyAscii - 22)
    ElseIf KeyAscii = 32 Then
        'pause for 7 units between words
        Sleep UNIT * 7
    ElseIf KeyAscii = 8 Then
        BeepMe LookUp(45)
    Else
        'special character
        Select Case KeyAscii
        Case 34
            BeepMe LookUp(36)
        Case 39
            BeepMe LookUp(37)
        Case 40 To 41
            BeepMe LookUp(38)
        Case 44 To 47
            BeepMe LookUp(KeyAscii - 5)
        Case 58
            BeepMe LookUp(43)
        Case 63
            BeepMe LookUp(44)
        End Select
    End If
    
End Sub

Private Sub BeepMe(Beeps As String)
    
    Dim temparray() As String
    
    temparray = Split(Beeps, &quot;/&quot;)
    
    For i = LBound(temparray) To UBound(temparray)
        If temparray(i) = &quot;.&quot; Then
            '&quot;.&quot; is 1 unit
            MyTone = Beep(FREQ, UNIT)
            'pause between components is 1 unit
            Sleep UNIT
        ElseIf temparray(i) = &quot;-&quot; Then
            '&quot;-&quot; is 3 units
            MyTone = Beep(FREQ, UNIT * 3)
            'pause between components is 1 unit
            Sleep UNIT
        End If
    Next i
    
    'wait 3 units after character
    Sleep UNIT * 3
    
End Sub

good luck!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383
 
couple of quick revisions!

in the delete section of the code:-

ElseIf KeyAscii = 8 Then
Text1 = Left$(Text1, InStrRev(Text1, &quot; &quot;) + 1)
Text1.SelStart = Len(Text1)
BeepMe LookUp(45)

i forgot to delete the whole word and was just deleting the last character

and in the beepme sub:-

'wait 3 units after character
Sleep UNIT * 2

because we already waited 1 unit after the last character!

hope it helps.. good luck!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
come on... get involved!
To get the best response to a question, please check out FAQ222-2244 first
A General Guide To Excel in VB FAQ222-3383
 
thankyou for all your help again but will this work on a website using vb script???
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top