Rem Morsecode sender for visual basic - copyright 2000 by AE9K
'**************************************************************
Rem Using an interface connected to the RTS line of a
Rem serial port this module will allow you to send morse code
Rem messages from your computer.

Rem Just add this module into any logging or keyer application
Rem you have written.

Rem First call the 'init_CW' Subroutine which sets up the port, timing factors and
Rem code speed. Default is Com2 and 13 WPM @ 100Mhz. You may have to
Rem adjust a weighting factor to compensate for the speed of
Rem your Computer. To determine the correct weighting factor number
Rem see comments in 'initCW' subroutine.

Rem To send a string create a text box and enter a message.
Rem then create a command button. Using the key click event
Rem call the subroutine 'send_String' and pass in the text box's
Rem text property as an argument.

Rem You don't have to use a text box. Create menu items that are
Rem strings too then associate function keys or mouse key
Rem with those string so whenyou click them the subroutine
Rem sendstring is called. For example. String a$ = "hello"
Rem will be send by calling sendString(a$)

Rem That's all there is to it. This module does not generate
Rem a sidetone, your radio should though.


Global Timing_Adjust As Long

Global Comm_Port As Integer

Dim TimeTick As Integer

'****************************************************************

Sub init_CW ()
 Comm_Port = 0
 'setPort (2)

 Rem the weightingfactor is adjusted to get correct CW speeds
 Rem depending onthe speed of the computer. To calibrate create
 Rem the message- "Now is the time for all good men to come to the aid of
 Rem their country. set the speed to 13 wpm. It should take about 1 minute to send
 Rem the characters in that message. The faster the computer the higher
 Rem the weighting factor.

 Set_Timing_Adjust (120)
 Set_Speed (13)           'Default speed is 13 wpm
End Sub

'********************************************************************
' Send one character in Morse code
Sub Send_Character (ch As String)  'character is passed in
Dim delay As Long

Rem character bit patterns - see the logic? The bit pattern
Rem that matched the character is placed in the buffer characterArray
Rem 1 = key down, 0 = key up x = end of character
Select Case UCase$(ch$)
Case " "
 characterArray = "0000000x"
Case "A"
 characterArray = "10111000x"
Case "B"
 characterArray = "111010101000x"
Case "C"
 characterArray = "11101011101000x"
Case "D"
 characterArray = "1110101000x"
Case "E"
 characterArray = "1000x"
Case "F"
 characterArray = "101011101000x"
Case "G"
 characterArray = "111011101000x"
Case "H"
 characterArray = "1010101000x"
Case "I"
 characterArray = "101000x"
Case "J"
 characterArray = "1011101110111000x"
Case "K"
 characterArray = "111010111000x"
Case "L"
 characterArray = "101110101000x"
Case "M"
 characterArray = "1110111000x"
Case "N"
 characterArray = "11101000x"
Case "O"
 characterArray = "11101110111000x"
Case "P"
 characterArray = "10111011101000x"
Case "Q"
 characterArray = "1110111010111000x"
Case "R"
 characterArray = "1011101000x"
Case "S"
 characterArray = "10101000x"
Case "T"
 characterArray = "111000x"
Case "U"
 characterArray = "1010111000x"
Case "V"
 characterArray = "101010111000x"
Case "W"
 characterArray = "101110111000x"
Case "X"
 characterArray = "11101010111000x"
Case "Y"
 characterArray = "1110101110111000x"
Case "Z"
 characterArray = "11101110101000x"
Case "0"
 characterArray = "1110111011101110111000x"
Case "1"
 characterArray = "10111011101110111000x"
Case "2"
 characterArray = "101011101110111000x"
Case "3"
 characterArray = "1010101110111000x"
Case "4"
 characterArray = "10101010111000x"
Case "5"
 characterArray = "101010101000x"
Case "6"
 characterArray = "11101010101000x"
Case "7"
 characterArray = "1110111010101000x"
Case "8"
 characterArray = "111011101110101000x"
Case "9"
 characterArray = "11101110111011101000x"
Case "."
 characterArray = "10111010111010111000x"
Case ","
 characterArray = "1110111010101110111000x"
Case "?"
 characterArray = "101011101110101000x"
Case "/"
 characterArray = "1110101011101000x"
Case "-"
 characterArray = "1110101010111000x"
End Select

bitPtr = 1   ' points to bit in bit pattern
charBit$ = ""   ' the bit in the bit pattern

Rem this scans throughthe bit pattern open and closing the key
While (charBit$ <> "x")
 charBit$ = Mid$(characterArray, bitPtr, 1)
 If (charBit$ = "1") Then
  form1.Comm.DTREnable = True   ' key down
 Else
  form1.Comm.DTREnable = False    'key up
 End If

 Rem Delay between bits, tiemtick is calculated by the set speed function
 For delay = 1 To TimeTick
    For delay2 = 1 To 10000
    Next delay2
 Next delay

 bitPtr = bitPtr + 1  ' point to next bit in pattern until an
Wend                  ' x is encountered

End Sub

'**********************************************************************
' Send a string of characters in Morse Code
Sub Send_String (chStr As String) 'pass in the string name
Dim charPtr As Long

If Comm_Port <> 0 Then
    For charPtr = 1 To Len(chStr$)  ' get each character form the string
        ch$ = Mid$(chStr, charPtr, 1)
        Send_Character (ch$)  ' send it to send character
        DoEvents             'handle other Visual basic stuff between characters
    Next charPtr             'get next character
End If

End Sub
'********************************************************************
Sub Set_Port (portSelect As Integer)
  oldport = Comm_Port
 On Error GoTo errHandler:
 
 If (Comm_Port <> 0) Then
   form1.Comm.PortOpen = False
 End If

 Comm_Port = portSelect
 
 If (Comm_Port <> 0) Then
 form1.Comm.CommPort = Comm_Port
 form1.Comm.DTREnable = False
 form1.Comm.PortOpen = True
 End If

 Exit Sub
errHandler:
 MsgBox ("Bad Port")
 Comm_Port = 0
Resume Next

End Sub
'**********************************************************************
'set up timing stuff since we use loops in our code instead of timers
Sub Set_Speed (wpm As Long)   ' pass in speed
TimeTick = Timing_Adjust / wpm
End Sub

'**********************************************************************
Sub Set_Timing_Adjust (x As Integer)
Timing_Adjust = x
End Sub

'**********************************************************************