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