CodeItBetter Programming Another VB Programming Blog

'Math - How to Conversion (Binary, Hexa Decimal, Octal, Decimal)
Option Explicit
 
Private OldBase As Integer
Private NewBase As Integer
 
Private Sub Form_Load()
'Initialize Old and New Base Type to Decimal
    OldBase = 10
    NewBase = 10
End Sub
 
Private Sub txtNumber_KeyPress(KeyAscii As Integer)
    'If the key is NOT Backspace or Delete or Left or Right
    If KeyAscii <> vbKeyBack Then
        'To Determine the Base Type
        Select Case OldBase
        Case 2
            'Only allow Binary numbers to be entered (0-1)
            If KeyAscii < vbKey0 Or KeyAscii > vbKey1 Then
                KeyAscii = 0
            End If
        Case 8
            'Only allow Octal numbers to be entered (0-7)
            If KeyAscii < vbKey0 Or KeyAscii > vbKey7 Then
                KeyAscii = 0
            End If
        Case 10
            'Only allow Decimal numbers to be entered (0-9)
            If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
                KeyAscii = 0
            End If
        Case 16
            'Only allow Hexidecimal numbers to be entered (0-9 & A-F)
            If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
                If KeyAscii < vbKeyA Or KeyAscii > vbKeyF Then
                    'If a-f then change to A-F
                    If KeyAscii >= 97 And KeyAscii <= 102 Then
                        KeyAscii = KeyAscii - 32
                    Else
                        KeyAscii = 0
                    End If
                End If
            End If
        End Select
    End If
End Sub
 
Private Sub optNumber_Click(Index As Integer)
    Dim OldNumber As String
    Dim NewNumber As String
    OldNumber = txtNumber.Text
    NewBase = optNumber(Index).Tag
    Select Case NewBase
    Case 2
        txtNumber.MaxLength = 50
    Case 8
        txtNumber.MaxLength = 17
    Case 10
        txtNumber.MaxLength = 15
    Case 16
        txtNumber.MaxLength = 13
    End Select
    'If Base Type was clicked but no numbers entered then
    'change Old and New Base to the Type selected and exit
    If OldNumber = "" Then
        OldBase = NewBase
        Exit Sub
    End If
    'Determine the Base Type combo we are dealing with
    Select Case True
    Case OldBase = 2 And NewBase = 2    'Binary & Binary
        NewNumber = OldNumber
    Case OldBase = 2 And NewBase = 8    'Binary & Octal
        NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase)
    Case OldBase = 2 And NewBase = 10   'Binary & Decimal
        NewNumber = Base2Dec(OldNumber, OldBase)
    Case OldBase = 2 And NewBase = 16   'Binary & Hexidecimal
        NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase)
    Case OldBase = 8 And NewBase = 2    'Octal & Binary
        NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase)
    Case OldBase = 8 And NewBase = 8    'Octal & Octal
        NewNumber = OldNumber
    Case OldBase = 8 And NewBase = 10   'Octal & Decimal
        NewNumber = Base2Dec(OldNumber, OldBase)
    Case OldBase = 8 And NewBase = 16   'Octal & Hexidecimal
        NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase)
    Case OldBase = 10 And NewBase = 2   'Decimal & Binary
        NewNumber = Dec2Base(OldNumber, NewBase)
    Case OldBase = 10 And NewBase = 8   'Decimal & Octal
        NewNumber = Dec2Base(OldNumber, NewBase)
    Case OldBase = 10 And NewBase = 10  'Decimal & Decimal
        NewNumber = OldNumber
    Case OldBase = 10 And NewBase = 16  'Decimal & Hexidecimal
        NewNumber = Dec2Base(OldNumber, NewBase)
    Case OldBase = 16 And NewBase = 2   'Hexidecimal & Binary
        NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase)
    Case OldBase = 16 And NewBase = 8   'Hexidecimal & Octal
        NewNumber = Dec2Base(Base2Dec(OldNumber, OldBase), NewBase)
    Case OldBase = 16 And NewBase = 10  'Hexidecimal & Decimal
        NewNumber = Base2Dec(OldNumber, OldBase)
    Case OldBase = 16 And NewBase = 16  'Hexidecimal & Hexidecimal
        NewNumber = OldNumber
    End Select
    txtNumber.Text = NewNumber
    OldBase = NewBase
End Sub
 
Private Function Dec2Base(ByVal DecNum, ByVal Base) As String
    Dim NHD As Double
    Dim HN As String
    'Convert until done
    While DecNum <> 0
        'Get the largest number of the Base Type
        NHD = DecNum - (Int(DecNum / Base) * Base)
        'Find it's converted Base number then concatenate
        'to the beginning of the resulting string
        HN = Mid("0123456789ABCDEF", NHD + 1, 1) & HN
        'Subtract the amount we converted
        DecNum = Int(DecNum / Base)
    Wend
    'Return our new number in the requested Base Type
    Dec2Base = HN
End Function
 
Private Function Base2Dec(BaseNum As String, ByVal Base) As String
    Dim BN As Double
    Dim I As Double
    Dim J As Double
    BN = 0
    J = 1
    'Step from Right to Left of the numbers
    For I = Len(BaseNum) To 1 Step -1
        'Determine what number we are dealing with then multiply its value
        'by the power of the Base Type then add it to the total resulting value
        Select Case UCase$(Mid$(BaseNum, I, 1))
        Case "0"
            BN = BN + J * 0
        Case "1"
            BN = BN + J * 1
        Case "2"
            BN = BN + J * 2
        Case "3"
            BN = BN + J * 3
        Case "4"
            BN = BN + J * 4
        Case "5"
            BN = BN + J * 5
        Case "6"
            BN = BN + J * 6
        Case "7"
            BN = BN + J * 7
        Case "8"
            BN = BN + J * 8
        Case "9"
            BN = BN + J * 9
        Case "A"
            BN = BN + J * 10
        Case "B"
            BN = BN + J * 11
        Case "C"
            BN = BN + J * 12
        Case "D"
            BN = BN + J * 13
        Case "E"
            BN = BN + J * 14
        Case "F"
            BN = BN + J * 15
        End Select
        'Multiply our Base Type Power times the Base to get our next power
        J = J * Base
    Next I
    'Return our new number in Decimal format
    Base2Dec = Trim(Str(BN))
End Function