Option Explicit
'Variables to hold Old Base Type and New Base Type
Private OldBase As Integer
Private NewBase As Integer
>In the form load:
Private Sub Form_Load()
    'Initialize Old and New Base Type to Decimal
    OldBase = 10
    NewBase = 10
End Sub
>in the textbox named txtnumber
Private Sub txtNumber_KeyPress(KeyAscii As Integer)
    'If the key is NOT Backspace or Delete or Left or Right
    If KeyAscii <> vbKeyBack Then
        'Determine the Base Type are we dealing with
        Select Case OldBase
            Case 2
                'Only allow Binary numbers to be entered (0-1)
                If KeyAscii <> vbKey1 Then
                    KeyAscii = 0
                End If
            Case 8
                'Only allow Octal numbers to be entered (0-7)
                If KeyAscii <> vbKey7 Then
                    KeyAscii = 0
                End If
            Case 10
                'Only allow Decimal numbers to be entered (0-9)
                If KeyAscii <> vbKey9 Then
                    KeyAscii = 0
                End If
            Case 16
                'Only allow Hexidecimal numbers to be entered (0-9 & A-F)
                If KeyAscii <> vbKey9 Then
                    If 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
>in the option buttons (oct, hex, decimal,bin) named optNumber:
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:
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
>another private 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
Subscribe to:
Post Comments (Atom)
 
 
2 comments:
Hi! Do you want to exchange links? I've PR3 also. Let me know, kay?
Thank you
Amber
ok add me and tell me your blog url
Post a Comment