Function hextoBin(ByVal X As String) As String
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
Dim i As Integer, s As String
hextoBin = ""
For i = 1 To Len(X)
hextoBin = hextoBin & Mid(Bins, (Val("&h" + Mid(X, i, 1)) * 4 + 1), 4)
Next
hextoBin = Format(hextoBin, "0")
End Function
''
''
'' PLEASE NOTE THAT THIS FUNCTION DOES
''
'' NOT
''
'' STRIP THE EXTRA ZEROS OFF THE FRONT OF THE
'' BINARY ANSWER.
''
''
'' Converts Hexadecimal to Binary
''
Dim I As Integer
Dim BinOut As String
Dim Lenhex As Integer
'' The length of the input
''
InputData = UCase(InputData)
Lenhex = Len(InputData)
For I = 1 To Lenhex
If IsNumeric(Mid(InputData, I, 1)) Then
''
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "A" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "B" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "C" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "D" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "E" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "F" Then
GoTo NumOk
Else
MsgBox "Number given is not in Hex format", vbCritical
Exit Function
End If
NumOk:
Next I
BinOut = ""
''
'' Convert the Number to Binary
''
For I = 1 To Lenhex
If Mid(InputData, I, 1) = "0" Then
BinOut = BinOut + "0000"
ElseIf Mid(InputData, I, 1) = "1" Then
BinOut = BinOut + "0001"
ElseIf Mid(InputData, I, 1) = "2" Then
BinOut = BinOut + "0010"
ElseIf Mid(InputData, I, 1) = "3" Then
BinOut = BinOut + "0011"
ElseIf Mid(InputData, I, 1) = "4" Then
BinOut = BinOut + "0100"
ElseIf Mid(InputData, I, 1) = "5" Then
BinOut = BinOut + "0101"
ElseIf Mid(InputData, I, 1) = "6" Then
BinOut = BinOut + "0110"
ElseIf Mid(InputData, I, 1) = "7" Then
BinOut = BinOut + "0111"
ElseIf Mid(InputData, I, 1) = "8" Then
BinOut = BinOut + "1000"
ElseIf Mid(InputData, I, 1) = "9" Then
BinOut = BinOut + "1001"
ElseIf Mid(InputData, I, 1) = "A" Then
BinOut = BinOut + "1010"
ElseIf Mid(InputData, I, 1) = "B" Then
BinOut = BinOut + "1011"
ElseIf Mid(InputData, I, 1) = "C" Then
BinOut = BinOut + "1100"
ElseIf Mid(InputData, I, 1) = "D" Then
BinOut = BinOut + "1101"
ElseIf Mid(InputData, I, 1) = "E" Then
BinOut = BinOut + "1110"
ElseIf Mid(InputData, I, 1) = "F" Then
BinOut = BinOut + "1111"
Else
MsgBox "Something is Screwed up, Wahhhhhhhhhhh", vbCritical
End If
Next I
Hex2Bin = BinOut
eds:
End Function
Private Sub cmdhex2bin_Click()
txtbinary2.Text = Hex2Bin(txthex2.Text)
End Sub
Function Bin2Hex(InputData As String) As String
''
'' Converts Binary to hex
''
Dim I As Integer
Dim LenBin As Integer
Dim JOne As String
Dim NumBlocks As Integer
Dim FullBin As String
Dim HexOut As String
Dim TempBinBlock As String
Dim TempHex As String
LenBin = Len(InputData)
''
'' Make sure that it is a Binary Number
''
For I = 1 To LenBin
JOne = Mid(InputData, I, 1)
If JOne <> "0" And JOne <> "1" Then
MsgBox "NOT A BINARY NUMBER", vbCritical
Exit Function
End If
Next I
'' Set the Variable to the Binary
''
FullBin = InputData
''
'' If the value is less than 4 in length, build it up.
''
If LenBin < 4 Then
If LenBin = 3 Then
FullBin = "0" + FullBin
ElseIf LenBin = 2 Then
FullBin = "00" + FullBin
ElseIf LenBin = 1 Then
FullBin = "000" + FullBin
ElseIf LenBin = 0 Then
MsgBox "Nothing Given..", vbCritical
Exit Function
End If
NumBlocks = 1
GoTo DoBlocks
End If
If LenBin = 4 Then
NumBlocks = 1
GoTo DoBlocks
End If
If LenBin > 4 Then
Dim TempHold As Currency
Dim TempDiv As Currency
Dim AfterDot As Integer
Dim Pos As Integer