AVRFreaks.net

Option Explicit
Dim mDontRecurse As Boolean

Private Sub Form_Load()
    mDontRecurse = False
End Sub

Private Sub txtBinary_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then DisplayValue txtBinary ',False

End Sub

Private Sub txtDecimal_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then DisplayValue txtDecimal ',False
End Sub

Private Sub txtHexadecimal_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then DisplayValue txtHexadecimal ',False

End Sub

Private Sub txtOctal_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then DisplayValue txtOctal ', False

End Sub

'-Displays values for Dec, Hex, Oct, and 32 Bit Binary
Private Sub DisplayValue(ByVal source As TextBox)
Dim sTmp As String
Dim lValue As Long
   
    ' Don't recurse.
    If mDontRecurse Then Exit Sub
    mDontRecurse = True

    ' Get the Value.
    On Error Resume Next
    Select Case source.Name
        Case "txtDecimal"
            lValue = CLng(source.Text)
        Case "txtHexadecimal"
            sTmp = UCase$(Trim$(source.Text))
            If Left$(sTmp, 2) <> "&H" Then sTmp = "&H" & sTmp
            lValue = CLng(sTmp)
        Case "txtOctal"
            sTmp = UCase$(Trim$(source.Text))
            If Left$(sTmp, 2) <> "&O" Then sTmp = "&O" & sTmp
            lValue = CLng(sTmp)
        Case "txtBinary"
            lValue = Binary2Long(source.Text)
    End Select
    On Error GoTo 0

    ' Display the lValue in their different formats.
    If source.Name <> "txtDecimal" Then
        txtDecimal.Text = Format$(lValue)
    End If
    If source.Name <> "txtHexadecimal" Then
        txtHexadecimal.Text = "&H" & Hex$(lValue)
    End If
    If source.Name <> "txtOctal" Then
        txtOctal.Text = "&O" & Oct$(lValue)
    End If
    If source.Name <> "txtBinary" Then
        txtBinary.Text = Long2Binary(lValue)
    End If

    mDontRecurse = False
End Sub
 

'Converts this 32 bit binary value into a Long.
Private Function Binary2Long(ByVal sBinaryValue As String) As Long
Dim sHexValue As String
Dim iNibble As Integer
Dim iNibbleValue As Integer
Dim iFactor As Integer
Dim iBit As Integer

    ' Remove any leading &B if present.
    ' (Note: &B is not a standard prefix, it just
    ' makes some sense.)
    sBinaryValue = UCase$(Trim$(sBinaryValue))
    If Left$(sBinaryValue, 2) = "&B" Then sBinaryValue = Mid$(sBinaryValue, 3)

    ' Strip out spaces in case the bytes are separated
    ' by spaces.
    sBinaryValue = Replace(sBinaryValue, " ", "")

    ' Left pad with zeros so we have a full 32 bits.
    sBinaryValue = Right$(String(32, "0") & sBinaryValue, 32)

    ' Read the bits in nibbles from right to left.
    ' (A nibble is half a byte. No kidding!)
    For iNibble = 7 To 0 Step -1
        ' Convert this nibble into a hexadecimal string.
        iFactor = 1
        iNibbleValue = 0

        ' Read the nibble's bits from right to left.
        For iBit = 3 To 0 Step -1
            If Mid$(sBinaryValue, 1 + iNibble * 4 + iBit, 1) = "1" Then
                iNibbleValue = iNibbleValue + iFactor
            End If
            iFactor = iFactor * 2
        Next iBit

        ' Add the nibble's value to the left of the
        ' result hex string.
        sHexValue = Hex$(iNibbleValue) & sHexValue
    Next iNibble

    ' Convert the result string into a long.
    Binary2Long = CLng("&H" & sHexValue)
End Function
 
 
 ' Converts this Long value into a 32 bit binary string.
Private Function Long2Binary(ByVal lValue As Long, _
    Optional ByVal bSeparateBinary As Boolean = True) As String
Dim sHex As String
Dim iDigit As Integer
Dim iDigitValue As Integer
Dim sNibble As String
Dim sResult As String
Dim iFactor As Integer
Dim iBit As Integer

    ' Convert into hex.
    sHex = Hex$(lValue)

    ' Zero-pad to a full 8 characters.
    sHex = Right$(String$(8, "0") & sHex, 8)

    ' Read the hexadecimal digits
    ' one at a time from right to left.
    For iDigit = 8 To 1 Step -1
        ' Convert this hexadecimal digit into a
        ' binary nibble.
        iDigitValue = CLng("&H" & Mid$(sHex, iDigit, 1))

        ' Convert the value into bits.
        iFactor = 1
        sNibble = ""
        For iBit = 3 To 0 Step -1
            If iDigitValue And iFactor Then
                sNibble = "1" & sNibble
            Else
                sNibble = "0" & sNibble
            End If
            iFactor = iFactor * 2
        Next iBit

        ' Add the nibble's string to the left of the
        ' result string.
        sResult = sNibble & sResult
    Next iDigit

    ' Add spaces between bytes if desired.
    If bSeparateBinary Then
        sResult = Mid$(sResult, 1, 8) & " " & _
                  Mid$(sResult, 9, 8) & " " & _
                  Mid$(sResult, 17, 8) & " " & _
                  Mid$(sResult, 25, 8)
    End If

    Long2Binary = sResult
   
End Function

    ' Add spaces between bytes if desired.
    If bSeparateBinary Then
        sResult = Mid$(sResult, 1, 8) & " " & _
                  Mid$(sResult, 9, 8) & " " & _
                  Mid$(sResult, 17, 8) & " " & _
                  Mid$(sResult, 25, 8)
    End If

    Long2Binary = sResult
   
End Function


'Edited: I get no respect. Even my code laughs at me!

Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Friend Class Converter
   Inherits System.Windows.Forms.Form
   Dim mDontRecurse As Boolean
   
   Private Sub Converter_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
      mDontRecurse = False
   End Sub
   
   Private Sub txtBinary_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txtBinary.KeyPress
      Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
      If KeyAscii = 13 Then DisplayValue(txtBinary) ',False
      
      eventArgs.KeyChar = Chr(KeyAscii)
      If KeyAscii = 0 Then
         eventArgs.Handled = True
      End If
   End Sub
   
   Private Sub txtDecimal_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txtDecimal.KeyPress
      Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
      If KeyAscii = 13 Then DisplayValue(txtDecimal) ',False
      eventArgs.KeyChar = Chr(KeyAscii)
      If KeyAscii = 0 Then
         eventArgs.Handled = True
      End If
   End Sub
   
   Private Sub txtHexadecimal_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txtHexadecimal.KeyPress
        Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
        If KeyAscii = 13 Then DisplayValue(txtHexadecimal)
      
      eventArgs.KeyChar = Chr(KeyAscii)
      If KeyAscii = 0 Then
         eventArgs.Handled = True
      End If
   End Sub
   
   Private Sub txtOctal_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txtOctal.KeyPress
      Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
        If KeyAscii = 13 Then DisplayValue(txtOctal)
      
      eventArgs.KeyChar = Chr(KeyAscii)
      If KeyAscii = 0 Then
         eventArgs.Handled = True
      End If
   End Sub
   
   '-Displays values for Dec, Hex, Oct, and 32 Bit Binary
   Private Sub DisplayValue(ByVal source As System.Windows.Forms.TextBox)
      Dim sTmp As String
      Dim lValue As Integer
      
      ' Don't recurse.
      If mDontRecurse Then Exit Sub
      mDontRecurse = True
      
      ' Get the Value.
      On Error Resume Next
      Select Case source.Name
         Case "txtDecimal"
            lValue = CInt(source.Text)
         Case "txtHexadecimal"
            sTmp = UCase(Trim(source.Text))
            If VB.Left(sTmp, 2) <> "&H" Then sTmp = "&H" & sTmp
            lValue = CInt(sTmp)
         Case "txtOctal"
            sTmp = UCase(Trim(source.Text))
            If VB.Left(sTmp, 2) <> "&O" Then sTmp = "&O" & sTmp
            lValue = CInt(sTmp)
         Case "txtBinary"
            lValue = Binary2Long(source.Text)
      End Select
      On Error GoTo 0
      
      ' Display the lValue in their different formats.
      If source.Name <> "txtDecimal" Then
         txtDecimal.Text = VB6.Format(lValue)
      End If
      If source.Name <> "txtHexadecimal" Then
         txtHexadecimal.Text = "&H" & Hex(lValue)
      End If
      If source.Name <> "txtOctal" Then
         txtOctal.Text = "&O" & Oct(lValue)
      End If
      If source.Name <> "txtBinary" Then
         txtBinary.Text = Long2Binary(lValue)
      End If
      
      mDontRecurse = False
   End Sub
   

   
   'Converts this 32 bit binary value into a Long.
   Private Function Binary2Long(ByVal sBinaryValue As String) As Integer
      Dim sHexValue As String
      Dim iNibble As Short
      Dim iNibbleValue As Short
      Dim iFactor As Short
      Dim iBit As Short

        sHexValue = ""
      ' Remove any leading &B if present.
      ' (Note: &B is not a standard prefix, it just
      ' makes some sense.)
      sBinaryValue = UCase(Trim(sBinaryValue))
      If VB.Left(sBinaryValue, 2) = "&B" Then sBinaryValue = Mid(sBinaryValue, 3)
      
      ' Strip out spaces in case the bytes are separated
      ' by spaces.
      sBinaryValue = Replace(sBinaryValue, " ", "")
      
      ' Left pad with zeros so we have a full 32 bits.
      sBinaryValue = VB.Right(New String("0", 32) & sBinaryValue, 32)
      
      ' Read the bits in nibbles from right to left.
      ' (A nibble is half a byte. No kidding!)
      For iNibble = 7 To 0 Step -1
         ' Convert this nibble into a hexadecimal string.
         iFactor = 1
         iNibbleValue = 0
         
         ' Read the nibble's bits from right to left.
         For iBit = 3 To 0 Step -1
            If Mid(sBinaryValue, 1 + iNibble * 4 + iBit, 1) = "1" Then
               iNibbleValue = iNibbleValue + iFactor
            End If
            iFactor = iFactor * 2
         Next iBit
         
         ' Add the nibble's value to the left of the
         ' result hex string.
         sHexValue = Hex(iNibbleValue) & sHexValue
      Next iNibble
      
      ' Convert the result string into a long.
      Binary2Long = CInt("&H" & sHexValue)
   End Function
   
   
   
   
   ' Converts this Long value into a 32 bit binary string.
   Private Function Long2Binary(ByVal lValue As Integer, Optional ByVal bSeparateBinary As Boolean = True) As String
      Dim sHex As String
      Dim iDigit As Short
      Dim iDigitValue As Short
      Dim sNibble As String
      Dim sResult As String
      Dim iFactor As Short
      Dim iBit As Short

        sResult = ""
      ' Convert into hex.
      sHex = Hex(lValue)
      
      ' Zero-pad to a full 8 characters.
      sHex = VB.Right(New String("0", 8) & sHex, 8)
      
      ' Read the hexadecimal digits
      ' one at a time from right to left.
      For iDigit = 8 To 1 Step -1
         ' Convert this hexadecimal digit into a
         ' binary nibble.
         iDigitValue = CInt("&H" & Mid(sHex, iDigit, 1))
         
         ' Convert the value into bits.
         iFactor = 1
         sNibble = ""
         For iBit = 3 To 0 Step -1
            If iDigitValue And iFactor Then
               sNibble = "1" & sNibble
            Else
               sNibble = "0" & sNibble
            End If
            iFactor = iFactor * 2
         Next iBit
         
         ' Add the nibble's string to the left of the
         ' result string.
         sResult = sNibble & sResult
      Next iDigit
      
      ' Add spaces between bytes if desired.
      If bSeparateBinary Then
         sResult = Mid(sResult, 1, 8) & " " & Mid(sResult, 9, 8) & " " & Mid(sResult, 17, 8) & " " & Mid(sResult, 25, 8)
      End If
      
      Long2Binary = sResult
      
   End Function
End Class

Private Static Sub CommModem3_OnComm()
Dim EVMsg$, ERMsg$, iRslt%
Dim buffer As Variant
   
    ' Branch according to the CommEvent property.
    Select Case CommModem3.CommEvent
        ' Event messages.
        Case comEvReceive
     
            buffer = CommModem3.Input
            Debug.Print "Receive - " & StrConv(buffer, vbUnicode)
            ShowData txtTermRX, (StrConv(buffer, vbUnicode))
           
            gdReceived = gdReceived + Len(StrConv(buffer, vbUnicode))
            If Timer2.Enabled = False Then
                sbrStatus.Panels("Status").Text = gdReceived & " Rec'd"
            End If
           
        Case comEvSend
       
        Case comEvCTS
            If imgCtsOff.Visible = True Then
                imgCtsOff.Visible = False
            Else
                imgCtsOff.Visible = True
            End If
            EVMsg$ = "Change in CTS Detected"
           
        Case comEvDSR
            If imgDsrOff.Visible = True Then
                imgDsrOff.Visible = False
            Else
                imgDsrOff.Visible = True
            End If
            EVMsg$ = "Change in DSR Detected"
        Case comEvCD
            If imgCdOff.Visible = True Then
                imgCdOff.Visible = False
            Else
                imgCdOff.Visible = True
            End If
            EVMsg$ = "Change in CD Detected"
        Case comEvRing
            If imgRiOff.Visible = True Then
                imgRiOff.Visible = False
            Else
                imgRiOff.Visible = True
            End If
            EVMsg$ = "The Phone is Ringing"
        Case comEvEOF
            EVMsg$ = "End of File Detected"

        ' Error messages.
        Case comBreak
            ERMsg$ = "Break Received"
        Case comCDTO
            ERMsg$ = "Carrier Detect Timeout"
        Case comCTSTO
            ERMsg$ = "CTS Timeout"
        Case comDCB
            ERMsg$ = "Error retrieving DCB"
        Case comDSRTO
            ERMsg$ = "DSR Timeout"
        Case comFrame
            ERMsg$ = "Framing Error"
        Case comOverrun
            ERMsg$ = "Overrun Error"
        Case comRxOver
            ERMsg$ = "Receive Buffer Overflow"
        Case comRxParity
            ERMsg$ = "Parity Error"
        Case comTxFull
            ERMsg$ = "Transmit Buffer Full"
        Case Else
            ERMsg$ = "Unknown error or event"
    End Select
   
    If Len(EVMsg$) Then
        ' Display event messages in the status bar.
        sbrStatus.Panels("Status").Text = "Status: " & EVMsg$
               
        ' Enable timer so that the message in the status bar
        ' is cleared after 2 seconds
        Timer2.Enabled = True
       
    ElseIf Len(ERMsg$) Then
        ' Display event messages in the status bar.
        sbrStatus.Panels("Status").Text = "Status: " & ERMsg$
       
        ' Display error messages in an alert message box.
        Beep
       iRslt = MsgBox(ERMsg$, 1, "Click Cancel to quit, OK to ignore.")
       
        ' If the user clicks Cancel (2)...
        If iRslt = 2 Then
            CommModem3.PortOpen = False    ' Close the port and quit.
        End If
       
        ' Enable timer so that the message in the status bar
        ' is cleared after 2 seconds
        Timer2.Enabled = True
    End If
End Sub

' Keystrokes trapped here are sent to the MSComm
' control where they are echoed back via the
' OnComm (comEvReceive) event, and displayed
' with the ShowData procedure.
Private Sub txtTermRX_KeyPress(KeyAscii As Integer)
    ' If the port is opened...
    If CommModem3.PortOpen Then
        ' Send the keystroke to the port.
        CommModem3.Output = Chr$(KeyAscii)

        ' Unless gbEcho is on, there is no need to
        ' let the text control display the key.
        ' A modem usually echos back a character
        If Not gbEcho(3) Then
            ' Place position at end of terminal
            txtTermRX.SelStart = Len(txtTermRX)
            KeyAscii = 0
        End If
    End If
     
End Sub

    // JWP 2/17/08 Set encoding to 8 bits - was ASCII
    serialPort1.Encoding = System.Text.Encoding.UTF8;