Function Bin2Dec(InputData As String) As Double '' '' This converts Binary to Decimal '' Dim DecOut As Double Dim I As Integer Dim LenBin As Double Dim JOne As StringLenBin = 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 DecOut = 0 For I = Len(InputData) To 1 Step -1 If Mid(InputData, I, 1) = "1" Then DecOut = DecOut + 2 ^ (Len(InputData) - I) End If Next I
Bin2Dec = DecOut
End FunctionFunction Dec2Bin(InputData As Double) As String '' '' Converts Decimal to Binary '' This uses the Quotient Remainder method '' Dim Quot As Double Dim Remainder As Double Dim BinOut As String Dim I As Integer Dim NewVal As Double Dim TempString As String Dim TempVal As Double Dim BinTemp As String Dim BinTemp1 As String Dim PosDot As Integer Dim Temp2 As String '' Check to see if there is a decimal point or not '' If InStr(1, CStr(InputData), ".") Then MsgBox "Only Whole Numbers can be converted", vbCritical GoTo eds End IfBinOut = "" NewVal = InputData DoAgain:'' Start the Calculations off NewVal = (NewVal / 2) '' If we have a remainder If InStr(1, CStr(NewVal), ".") Then BinOut = BinOut + "1"
'' Get rid of the Remainder NewVal = Format(NewVal, "#0") NewVal = (NewVal - 1)
If NewVal < 1 Then GoTo DoneIt End If Else BinOut = BinOut + "0" If NewVal < 1 Then GoTo DoneIt End If End If GoTo DoAgainDoneIt:BinTemp = ""'' Reverse the Result For I = Len(BinOut) To 1 Step -1 BinTemp1 = Mid(BinOut, I, 1) BinTemp = BinTemp + BinTemp1 Next IBinOut = BinTemp'' Output the Result Dec2Bin = BinOut eds: End FunctionFunction 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 StringLenBin = 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 IfIf LenBin > 4 ThenDim TempHold As Currency Dim TempDiv As Currency Dim AfterDot As Integer Dim Pos As IntegerTempHold = Len(InputData) TempDiv = (TempHold / 4)'' '' Works by seeing whats after the deciomal place '' Pos = InStr(1, CStr(TempDiv), ".")If Pos = 0 Then '' Divided by 4 perfectly NumBlocks = TempDiv GoTo DoBlocks End IfAfterDot = Mid(CStr(TempDiv), (Pos + 1))If AfterDot = 25 Then FullBin = "000" + FullBin NumBlocks = (Len(FullBin) / 4) ElseIf AfterDot = 5 Then FullBin = "00" + FullBin NumBlocks = (Len(FullBin) / 4) ElseIf AfterDot = 75 Then FullBin = "0" + FullBin NumBlocks = (Len(FullBin) / 4) Else MsgBox "Big Time Screw up happened, WAHHHHHHHHHHH", vbInformation Exit Function End If GoTo DoBlocks End If '' '' The rest will process the now built up number '' DoBlocks:HexOut = "" For I = 1 To Len(FullBin) Step 4 TempBinBlock = Mid(FullBin, I, 4)If TempBinBlock = "0000" Then HexOut = HexOut + "0" ElseIf TempBinBlock = "0001" Then HexOut = HexOut + "1" ElseIf TempBinBlock = "0010" Then HexOut = HexOut + "2" ElseIf TempBinBlock = "0011" Then HexOut = HexOut + "3" ElseIf TempBinBlock = "0100" Then HexOut = HexOut + "4" ElseIf TempBinBlock = "0101" Then HexOut = HexOut + "5" ElseIf TempBinBlock = "0110" Then HexOut = HexOut + "6" ElseIf TempBinBlock = "0111" Then HexOut = HexOut + "7" ElseIf TempBinBlock = "1000" Then HexOut = HexOut + "8" ElseIf TempBinBlock = "1001" Then HexOut = HexOut + "9" ElseIf TempBinBlock = "1010" Then HexOut = HexOut + "A" ElseIf TempBinBlock = "1011" Then HexOut = HexOut + "B" ElseIf TempBinBlock = "1100" Then HexOut = HexOut + "C" ElseIf TempBinBlock = "1101" Then HexOut = HexOut + "D" ElseIf TempBinBlock = "1110" Then HexOut = HexOut + "E" ElseIf TempBinBlock = "1111" Then HexOut = HexOut + "F" End IfNext I Bin2Hex = HexOuteds: End Function
Function Hex2Bin(InputData As String) As String '' '' '' 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 LenhexIf 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 IfNumOk: Next IBinOut = "" '' '' Convert the Number to Binary '' For I = 1 To LenhexIf 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 IHex2Bin = BinOuteds: End Function Function Hex2Dec(InputData As String) As Double '' '' Converts Hexadecimal to Decimal '' Dim I As Integer Dim DecOut As Double Dim Lenhex As Integer Dim HexStep As Double '' Zeroise the output DecOut = 0'' The length of the input '' InputData = UCase(InputData) Lenhex = Len(InputData)'' '' Check to make sure its a valid Hex Number '' For I = 1 To LenhexIf 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 IfNumOk: Next IHexStep = 0'' '' '' Convert the Number to Decimal '' For I = Lenhex To 1 Step -1HexStep = HexStep * 16 If HexStep = 0 Then HexStep = 1 End If If Mid(InputData, I, 1) = "0" Then DecOut = DecOut + (0 * HexStep) ElseIf Mid(InputData, I, 1) = "1" Then DecOut = DecOut + (1 * HexStep) ElseIf Mid(InputData, I, 1) = "2" Then DecOut = DecOut + (2 * HexStep) ElseIf Mid(InputData, I, 1) = "3" Then DecOut = DecOut + (3 * HexStep) ElseIf Mid(InputData, I, 1) = "4" Then DecOut = DecOut + (4 * HexStep) ElseIf Mid(InputData, I, 1) = "5" Then DecOut = DecOut + (5 * HexStep) ElseIf Mid(InputData, I, 1) = "6" Then DecOut = DecOut + (6 * HexStep) ElseIf Mid(InputData, I, 1) = "7" Then DecOut = DecOut + (7 * HexStep) ElseIf Mid(InputData, I, 1) = "8" Then DecOut = DecOut + (8 * HexStep) ElseIf Mid(InputData, I, 1) = "9" Then DecOut = DecOut + (9 * HexStep) ElseIf Mid(InputData, I, 1) = "A" Then DecOut = DecOut + (10 * HexStep) ElseIf Mid(InputData, I, 1) = "B" Then DecOut = DecOut + (11 * HexStep) ElseIf Mid(InputData, I, 1) = "C" Then DecOut = DecOut + (12 * HexStep) ElseIf Mid(InputData, I, 1) = "D" Then DecOut = DecOut + (13 * HexStep) ElseIf Mid(InputData, I, 1) = "E" Then DecOut = DecOut + (14 * HexStep) ElseIf Mid(InputData, I, 1) = "F" Then DecOut = DecOut + (15 * HexStep) Else MsgBox "Something is Screwed up, Wahhhhhhhhhhh", vbCritical End IfNext IHex2Dec = DecOuteds: End Function
Function Bin2Dec(InputData As String) As Double
''
'' This converts Binary to Decimal
''
Dim DecOut As Double
Dim I As Integer
Dim LenBin As Double
Dim JOne As StringLenBin = 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
DecOut = 0
For I = Len(InputData) To 1 Step -1
If Mid(InputData, I, 1) = "1" Then
DecOut = DecOut + 2 ^ (Len(InputData) - I)
End If
Next I
Bin2Dec = DecOut
End FunctionFunction Dec2Bin(InputData As Double) As String
''
'' Converts Decimal to Binary
'' This uses the Quotient Remainder method
''
Dim Quot As Double
Dim Remainder As Double
Dim BinOut As String
Dim I As Integer
Dim NewVal As Double
Dim TempString As String
Dim TempVal As Double
Dim BinTemp As String
Dim BinTemp1 As String
Dim PosDot As Integer
Dim Temp2 As String
'' Check to see if there is a decimal point or not
''
If InStr(1, CStr(InputData), ".") Then
MsgBox "Only Whole Numbers can be converted", vbCritical
GoTo eds
End IfBinOut = ""
NewVal = InputData
DoAgain:'' Start the Calculations off
NewVal = (NewVal / 2)
'' If we have a remainder
If InStr(1, CStr(NewVal), ".") Then
BinOut = BinOut + "1"
'' Get rid of the Remainder
NewVal = Format(NewVal, "#0")
NewVal = (NewVal - 1)
If NewVal < 1 Then
GoTo DoneIt
End If
Else
BinOut = BinOut + "0"
If NewVal < 1 Then
GoTo DoneIt
End If
End If
GoTo DoAgainDoneIt:BinTemp = ""'' Reverse the Result
For I = Len(BinOut) To 1 Step -1
BinTemp1 = Mid(BinOut, I, 1)
BinTemp = BinTemp + BinTemp1
Next IBinOut = BinTemp'' Output the Result
Dec2Bin = BinOut
eds:
End FunctionFunction 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 StringLenBin = 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 IfIf LenBin > 4 ThenDim TempHold As Currency
Dim TempDiv As Currency
Dim AfterDot As Integer
Dim Pos As IntegerTempHold = Len(InputData)
TempDiv = (TempHold / 4)''
'' Works by seeing whats after the deciomal place
''
Pos = InStr(1, CStr(TempDiv), ".")If Pos = 0 Then
'' Divided by 4 perfectly
NumBlocks = TempDiv
GoTo DoBlocks
End IfAfterDot = Mid(CStr(TempDiv), (Pos + 1))If AfterDot = 25 Then
FullBin = "000" + FullBin
NumBlocks = (Len(FullBin) / 4)
ElseIf AfterDot = 5 Then
FullBin = "00" + FullBin
NumBlocks = (Len(FullBin) / 4)
ElseIf AfterDot = 75 Then
FullBin = "0" + FullBin
NumBlocks = (Len(FullBin) / 4)
Else
MsgBox "Big Time Screw up happened, WAHHHHHHHHHHH", vbInformation
Exit Function
End If
GoTo DoBlocks
End If
''
'' The rest will process the now built up number
''
DoBlocks:HexOut = ""
For I = 1 To Len(FullBin) Step 4
TempBinBlock = Mid(FullBin, I, 4)If TempBinBlock = "0000" Then
HexOut = HexOut + "0"
ElseIf TempBinBlock = "0001" Then
HexOut = HexOut + "1"
ElseIf TempBinBlock = "0010" Then
HexOut = HexOut + "2"
ElseIf TempBinBlock = "0011" Then
HexOut = HexOut + "3"
ElseIf TempBinBlock = "0100" Then
HexOut = HexOut + "4"
ElseIf TempBinBlock = "0101" Then
HexOut = HexOut + "5"
ElseIf TempBinBlock = "0110" Then
HexOut = HexOut + "6"
ElseIf TempBinBlock = "0111" Then
HexOut = HexOut + "7"
ElseIf TempBinBlock = "1000" Then
HexOut = HexOut + "8"
ElseIf TempBinBlock = "1001" Then
HexOut = HexOut + "9"
ElseIf TempBinBlock = "1010" Then
HexOut = HexOut + "A"
ElseIf TempBinBlock = "1011" Then
HexOut = HexOut + "B"
ElseIf TempBinBlock = "1100" Then
HexOut = HexOut + "C"
ElseIf TempBinBlock = "1101" Then
HexOut = HexOut + "D"
ElseIf TempBinBlock = "1110" Then
HexOut = HexOut + "E"
ElseIf TempBinBlock = "1111" Then
HexOut = HexOut + "F"
End IfNext I
Bin2Hex = HexOuteds:
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 LenhexIf 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 IfNumOk:
Next IBinOut = ""
''
'' Convert the Number to Binary
''
For I = 1 To LenhexIf 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 IHex2Bin = BinOuteds:
End Function
Function Hex2Dec(InputData As String) As Double
''
'' Converts Hexadecimal to Decimal
''
Dim I As Integer
Dim DecOut As Double
Dim Lenhex As Integer
Dim HexStep As Double
'' Zeroise the output
DecOut = 0'' The length of the input
''
InputData = UCase(InputData)
Lenhex = Len(InputData)''
'' Check to make sure its a valid Hex Number
''
For I = 1 To LenhexIf 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 IfNumOk:
Next IHexStep = 0''
''
'' Convert the Number to Decimal
''
For I = Lenhex To 1 Step -1HexStep = HexStep * 16
If HexStep = 0 Then
HexStep = 1
End If If Mid(InputData, I, 1) = "0" Then
DecOut = DecOut + (0 * HexStep)
ElseIf Mid(InputData, I, 1) = "1" Then
DecOut = DecOut + (1 * HexStep)
ElseIf Mid(InputData, I, 1) = "2" Then
DecOut = DecOut + (2 * HexStep)
ElseIf Mid(InputData, I, 1) = "3" Then
DecOut = DecOut + (3 * HexStep)
ElseIf Mid(InputData, I, 1) = "4" Then
DecOut = DecOut + (4 * HexStep)
ElseIf Mid(InputData, I, 1) = "5" Then
DecOut = DecOut + (5 * HexStep)
ElseIf Mid(InputData, I, 1) = "6" Then
DecOut = DecOut + (6 * HexStep)
ElseIf Mid(InputData, I, 1) = "7" Then
DecOut = DecOut + (7 * HexStep)
ElseIf Mid(InputData, I, 1) = "8" Then
DecOut = DecOut + (8 * HexStep)
ElseIf Mid(InputData, I, 1) = "9" Then
DecOut = DecOut + (9 * HexStep)
ElseIf Mid(InputData, I, 1) = "A" Then
DecOut = DecOut + (10 * HexStep)
ElseIf Mid(InputData, I, 1) = "B" Then
DecOut = DecOut + (11 * HexStep)
ElseIf Mid(InputData, I, 1) = "C" Then
DecOut = DecOut + (12 * HexStep)
ElseIf Mid(InputData, I, 1) = "D" Then
DecOut = DecOut + (13 * HexStep)
ElseIf Mid(InputData, I, 1) = "E" Then
DecOut = DecOut + (14 * HexStep)
ElseIf Mid(InputData, I, 1) = "F" Then
DecOut = DecOut + (15 * HexStep)
Else
MsgBox "Something is Screwed up, Wahhhhhhhhhhh", vbCritical
End IfNext IHex2Dec = DecOuteds:
End Function