by Larrin Habeger (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 6th April 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Convert decimal, octal, and hexadecimal to binary and binary to decimal, octal, and hexadecimal. Works on string representation of the
VBcoders
LLLLLLLLL aaa rrr rrr rrrrrr iiiiiiiii nnn nnn
LLLLLLLLLL aaa rrrr rrr rrrrrrrr iiiiiiiiii nnn nnn
LLL LLL aaa rrrrr rrr rrr rrr iii iii nnn nnn
LLL LLL aaa rrrrrr rrr rrr rrr iii ii nnn nnn
LLLLLLLLLL aaa rrr rrr rrr rrr rrr iii iii nnnnn
LLLLLLLLLL aaa rrr rrr rrr rrrrrrrrrrrr iiiiiiiiii nnn
LLL LLL aaa rrr rrrrrr rrrrrrrrrrrr iiiiiiiiii nnn
LLL LLL aaa rrr rrrrr rrr rrr iii iii nnn
LLLLLLLLLL aaa rrr rrrr rrr rrr iii iii nnn
LLLLLLLLL aaa rrr rrr rrr rrr iii iii nnn
The Functions in this module are designed to aid in working with BINARY
numbers. Visual Basic does not include nor allow any representation of a
number in binary format. Therefore, all of these functions work strictly on
strings. All of the parameters passed into them and returned from them are
strings.
CONVERSION NEEDED FUNCTION
------------------------------------------------------
Binary to Hex BinToHex(BinNum As String)
Binary to Octal BinToOct(BinNum As String)
Binary to Decimal BinToDec(BinNum As String)
Hex to Binary HexToBin(HexNum As String)
Octal to Binary OctToBin(OctNum As String)
Decimal to Binary DecToBin(DecNum As String)
Option Explicit
Function BinToHex(BinNum As String) As String
Dim BinLen As Integer, i As Integer
Dim HexNum As Variant
On Error GoTo ErrorHandler
BinLen = Len(BinNum)
For i = BinLen To 1 Step -1
Check the string for invalid characters
If Asc(Mid(BinNum, i, 1)) < 48 Or _
Asc(Mid(BinNum, i, 1)) > 49 Then
HexNum = ""
Err.Raise 1002, "BinToHex", "Invalid Input"
End If
Calculate HEX value of BinNum
If Mid(BinNum, i, 1) And 1 Then
HexNum = HexNum + 2 ^ Abs(i - BinLen)
End If
Next i
Return HexNum as String
BinToHex = Hex(HexNum)
ErrorHandler:
End Function
Function BinToOct(BinNum As String) As String
Dim BinLen As Integer, i As Integer
Dim OctNum As Variant
On Error GoTo ErrorHandler
BinLen = Len(BinNum)
For i = BinLen To 1 Step -1
Check the string for invalid characters
If Asc(Mid(BinNum, i, 1)) < 48 Or _
Asc(Mid(BinNum, i, 1)) > 49 Then
OctNum = ""
Err.Raise 1002, "BinToOct", "Invalid Input"
End If
Calculate Octal value of BinNum
If Mid(BinNum, i, 1) And 1 Then
OctNum = OctNum + 2 ^ Abs(i - BinLen)
End If
Next i
Return OctNum as String
BinToOct = Oct(OctNum)
ErrorHandler:
End Function
Public Function BinToDec(BinNum As String) As String
Dim i As Integer
Dim DecNum As Long
On Error GoTo ErrorHandler
Loop thru BinString
For i = Len(BinNum) To 1 Step -1
Check the string for invalid characters
If Asc(Mid(BinNum, i, 1)) < 48 Or _
Asc(Mid(BinNum, i, 1)) > 49 Then
DecNum = ""
Err.Raise 1002, "BinToDec", "Invalid Input"
End If
If bit is 1 then raise 2^LoopCount and add it to DecNum
If Mid(BinNum, i, 1) And 1 Then
DecNum = DecNum + 2 ^ (Len(BinNum) - i)
End If
Next i
Return DecNum as a String
BinToDec = DecNum
ErrorHandler:
End Function
Public Function OctToBin(OctNum As String) As String
Dim BinNum As String
Dim lOctNum As Long
Dim i As Integer
On Error GoTo ErrorHandler
Check the string for invalid characters
For i = 1 To Len(OctNum)
If (Asc(Mid(OctNum, i, 1)) < 48 Or Asc(Mid(OctNum, i, 1)) > 55) Then
BinNum = ""
Err.Raise 1008, "OctToBin", "Invalid Input"
End If
Next i
i = 0
lOctNum = Val("&O" & OctNum)
Do
If lOctNum And 2 ^ i Then
BinNum = "1" & BinNum
Else
BinNum = "0" & BinNum
End If
i = i + 1
Loop Until 2 ^ i > lOctNum
Return BinNum as a String
OctToBin = BinNum
ErrorHandler:
End Function
Public Function DecToBin(DecNum As String) As String
Dim BinNum As String
Dim lDecNum As Long
Dim i As Integer
On Error GoTo ErrorHandler
Check the string for invalid characters
For i = 1 To Len(DecNum)
If Asc(Mid(DecNum, i, 1)) < 48 Or _
Asc(Mid(DecNum, i, 1)) > 57 Then
BinNum = ""
Err.Raise 1010, "DecToBin", "Invalid Input"
End If
Next i
i = 0
lDecNum = Val(DecNum)
Do
If lDecNum And 2 ^ i Then
BinNum = "1" & BinNum
Else
BinNum = "0" & BinNum
End If
i = i + 1
Loop Until 2 ^ i > lDecNum
Return BinNum as a String
DecToBin = BinNum
ErrorHandler:
End Function
Public Function HexToBin(HexNum As String) As String
Dim BinNum As String
Dim lHexNum As Long
Dim i As Integer
On Error GoTo ErrorHandler
Check the string for invalid characters
For i = 1 To Len(HexNum)
If ((Asc(Mid(HexNum, i, 1)) < 48) Or _
(Asc(Mid(HexNum, i, 1)) > 57 And _
Asc(UCase(Mid(HexNum, i, 1))) < 65) Or _
(Asc(UCase(Mid(HexNum, i, 1))) > 70)) Then
BinNum = ""
Err.Raise 1016, "HexToBin", "Invalid Input"
End If
Next i
i = 0
lHexNum = Val("&h" & HexNum)
Do
If lHexNum And 2 ^ i Then
BinNum = "1" & BinNum
Else
BinNum = "0" & BinNum
End If
i = i + 1
Loop Until 2 ^ i > lHexNum
Return BinNum as a String
HexToBin = BinNum
ErrorHandler:
End Function
No comments have been posted about Convert decimal, octal, and hexadecimal to binary and binary to decimal, octal, and hexadecimal. Wo. Why not be the first to post a comment about Convert decimal, octal, and hexadecimal to binary and binary to decimal, octal, and hexadecimal. Wo.