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