by J.Edwards (2 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 11th February 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This module will convert Decimal, Binary, Hex, & Octal numbers to any of the previous. Add the module to any project and return the function.
VBcoders
Dim Digit(30) As Double
Dim BinaryDigit(30) As Integer
Private BaseNumberFrom As String
Dim DecOut As Double
Dim LetterFound As Boolean
Dim Multiplier As Double
Dim HexStr As String
Dim OctStr As String
Dim I As Integer
Dim J As String
Dim K As Integer
Public Type ConvertFrom
DECIMAL As String
BINARY As String
HEX As String
OCTAL As String
End Type
Public Type ConvertTo
To_Decimal As String
To_Binary As String
To_Hex As String
To_Octal As String
End Type
Public Function CalculateBase(ByRef From As String, ConvertInTo As String, NumberFrom As String) As String
Select Case From
Case "DECIMAL"
Select Case ConvertInTo
Case "To_Decimal"
CalculateBase = NumberFrom
Case "To_Binary"
CalculateBase = GetBinaryNumber(NumberFrom)
Case "To_Hex"
CalculateBase = HEX(NumberFrom)
Case "To_Octal"
CalculateBase = Oct(NumberFrom)
End Select
'---------------------------------------------------------------------------------------------
Case "BINARY"
Select Case ConvertInTo
Case "To_Decimal"
CalculateBase = GetDecimalNumber(NumberFrom)
Case "To_Binary"
CalculateBase = NumberFrom
Case "To_Hex"
CalculateBase = HEX(GetDecimalNumber(NumberFrom))
Case "To_Octal"
CalculateBase = Oct(GetDecimalNumber(NumberFrom))
End Select
'---------------------------------------------------------------------------------------------
Case "HEX"
Select Case ConvertInTo
Case "To_Decimal"
CalculateBase = HexToDecimal(NumberFrom)
Case "To_Binary"
CalculateBase = GetBinaryNumber(HexToDecimal(NumberFrom))
Case "To_Hex"
CalculateBase = NumberFrom
Case "To_Octal"
CalculateBase = Oct(HexToDecimal(NumberFrom))
End Select
'---------------------------------------------------------------------------------------------
Case "OCTAL"
Select Case ConvertInTo
Case "To_Decimal"
CalculateBase = OctalToDecimal(NumberFrom)
Case "To_Binary"
CalculateBase = GetBinaryNumber(OctalToDecimal(NumberFrom))
Case "To_Hex"
CalculateBase = HEX(OctalToDecimal(NumberFrom))
Case "To_Octal"
CalculateBase = NumberFrom
End Select
End Select
End Function
Public Function GetBinaryNumber(Number As String) As String
Dim Locater As Integer
Dim DecimalCheck As Integer
Dim BinaryNumber As String
For I = 0 To 30
BinaryDigit(I) = 0 'set binary digits to Jero
Next I
I = 0
Digit(30) = 1
For I = 29 To 0 Step -1 'multiply each successive digit by 2
Digit(I) = Digit(I + 1) * 2
Next I
If Number > Digit(0) Then '2 to power 30 = this so check for bigger
MsgBox "This Number is too Large"
Exit Function
End If
DecimalCheck = InStr(1, Number, ".", vbTextCompare) 'look for decimal point
If DecimalCheck > 0 Then 'if decimal found exit function
MsgBox "please no decimals"
Exit Function
End If
If Number < 0 Then 'look for neative numbers
MsgBox "please no negative numbers"
Exit Function
End If
I = 0
For I = 0 To 30
If Number >= Digit(I) Then
Number = Number - Digit(I)
BinaryDigit(I) = 1
End If
Next I
I = 0 'reset counter
BinaryNumber = 0
For I = 0 To 30 'put together binary sequence
BinaryNumber = BinaryNumber & BinaryDigit(I)
Next I
Locater = InStr(1, BinaryNumber, 1, vbTextCompare) 'look for first 1 in binary sequence
GetBinaryNumber = Mid(BinaryNumber, Locater, 30) 'remove leading Jeros
End Function
Public Function GetDecimalNumber(BinaryNumber As String) As String
Dim Locater As Double
Dim StrLength As Integer
Dim DecimalNumber As Double
Digit(0) = 1 'setup binary multipliers
I = 0
For I = 1 To 30
Digit(I) = Digit(I - 1) * 2
Next I
StrLength = Len(BinaryNumber) 'get length of binary string
BinaryNumber = StrReverse(BinaryNumber) 'reverse binary string
DecimalNumber = 0 'reset decimal number
For I = 1 To StrLength
Locater = Mid(BinaryNumber, I, 1) 'get digit from binary string
DecimalNumber = DecimalNumber + (Val(Digit(I - 1)) * Locater) 'multiply digit by binary power
Next I 'and add to total
GetDecimalNumber = DecimalNumber
End Function
Function OctalToDecimal(myoct As String) As Double
Multiplier = 1
DecOut = 0
OctStr = "01234567"
For I = Len(myoct) To 1 Step -1
J = Mid(myoct, I, 1)
K = Val(InStr(1, OctStr, Val(J))) - 1
If K + 1 = 0 Then
MsgBox "Invalid input", , "Error"
DecOut = -1
Exit Function
End If
DecOut = DecOut + K * Multiplier
Multiplier = Multiplier * 8
Next I
OctalToDecimal = DecOut
End Function
Function HexToDecimal(myHex As String) As String
Multiplier = 1
DecOut = 0
HexStr = "0123456789ABCDEF"
For I = Len(myHex) To 1 Step -1
J = Mid(myHex, I, 1)
Select Case CStr(J)
Case "A"
J = 10
LetterFound = True
Case "B"
J = 11
LetterFound = True
Case "C"
J = 12
LetterFound = True
Case "D"
J = 13
LetterFound = True
Case "E"
J = 14
LetterFound = True
Case "F"
J = 15
LetterFound = True
Case Else
LetterFound = False
End Select
Select Case LetterFound
Case True
DecOut = DecOut + Val(J) * Multiplier
Case False
K = Val(InStr(1, HexStr, Val(J))) - 1
If K + 1 = 0 Then
MsgBox "Invalid input", , "Error"
DecOut = -1
Exit Function
End If
DecOut = DecOut + K * Multiplier
End Select
Multiplier = Multiplier * 16
Next I
HexToDecimal = DecOut
End Function
No comments have been posted about This module will convert Decimal, Binary, Hex, & Octal numbers to any of the previous. Add the modu. Why not be the first to post a comment about This module will convert Decimal, Binary, Hex, & Octal numbers to any of the previous. Add the modu.