modnumbase.bas

AD9954源码

    Dim iNibble As Integer
    Dim retval As Variant
    
    retval = CDec(0)
    
    'Initialize nibble as a decimal value
'    Nibble = 0
    
    'Loop through all of the nibbles
    For cntr = 0 To Len(HexStr) - 1
        'Get the first nibble
        sNibble = Right(HexStr, 1)
        'Trimm off the LSN
        HexStr = Left(HexStr, Len(HexStr) - 1)
        
        'Check the current character to see if it is a valid character
        Select Case Asc(sNibble)
            Case 48 To 57
            Case 65 To 70
            Case 97 To 102
            Case Else
                'If not raise an error and exit the function
                Err.Raise 13, "cbaseHexStr2Dec()", "Type mismatch - Invalid input string."
                Exit Function
        End Select
        
        'Convert the nibble to an integer
        iNibble = CInt("&h" & sNibble)
        If cntr = 0 Then
            'Add the LSN
            retval = iNibble
        Else
            'Add up the nibbles
            retval = retval + (iNibble * (16 ^ cntr))
        End If
    Next cntr
    
    'Return the calcualted integer value
    cbaseHexStr2Dec = retval
End Function
'Performs the modulos function on Decimal values
'divides Num by Divisor and returns the remainder
Public Function DecMod(ByVal num As Variant, ByVal Divisor As Variant) As Variant
    Dim TempVal As Variant
    'Initialize as a decimal value
    TempVal = CDec(0)
    
    'Do the division
    TempVal = num / Divisor
    
    'Calculate the remainder
    DecMod = (TempVal - DecFix(TempVal)) * Divisor
End Function

'Returns the decimal seperator in either ascii code or
'the character
Private Function GetDecSeparator(ByVal RetAsciiCode As Boolean) As Variant
    If RetAsciiCode Then
        GetDecSeparator = Asc(Mid(Format(0, "Fixed"), 2, 1))
    Else
        GetDecSeparator = Mid(Format(0, "Fixed"), 2, 1)
    End If
End Function

'Compliments a binary string
'Used to display the Frequency Step Word in 2's Compliment
Public Function ComplBinStr(ByVal BinStr) As String
    Dim cntr As Integer
    Dim NewStr As String
    
    For cntr = 1 To Len(BinStr)
        If Mid(BinStr, cntr, 1) = "1" Then
            NewStr = NewStr & "0"
        Else
            NewStr = NewStr & "1"
        End If
    Next
    
    ComplBinStr = NewStr
End Function
'Converts decimal values to hexstring and properly handles negative values
Public Function cbaseSignedDec2Hex(ByVal num As Variant, Optional ByVal DigitsToDisplay As Integer = 0) As String
    Dim cntr As Integer
    Dim HexStr As String
    Dim BinStr As String
    Dim LookUP(0 To 16) As String
    Dim cntr1 As Integer
    Dim BinDigitStr As String
    
    'Initialize the lookup table
    LookUP(0) = "0000"
    LookUP(1) = "0001"
    LookUP(2) = "0010"
    LookUP(3) = "0011"
    LookUP(4) = "0100"
    LookUP(5) = "0101"
    LookUP(6) = "0110"
    LookUP(7) = "0111"
    LookUP(8) = "1000"
    LookUP(9) = "1001"
    LookUP(10) = "1010"
    LookUP(11) = "1011"
    LookUP(12) = "1100"
    LookUP(13) = "1101"
    LookUP(14) = "1110"
    LookUP(15) = "1111"
    LookUP(16) = "ERRR"
    
    'First convert the decimal number to a binary string
    BinStr = cbaseDec2Bin(num, DigitsToDisplay * 4)
    
    'Loop through the binary string and convert it digit by digit
    For cntr = 1 To DigitsToDisplay
        'Get the binary value for the first digit
        BinDigitStr = Right(BinStr, 4)
        'Trim off the bits
        BinStr = Left(BinStr, (DigitsToDisplay - cntr) * 4)
        'Scan through the lookup table and find the matching value
        For cntr1 = 0 To 16
            If LookUP(cntr1) = BinDigitStr Then
                'Found it
                Exit For
            End If
        Next cntr1
        'Check and make sure that the digit was found in the lookup table
        If cntr1 <> 16 Then
            'Build the hex string
            HexStr = Hex(cntr1) & HexStr
        Else
            MsgBox "Error: Couldn't find digit in lookup table.", vbCritical, "Function cbaseDec2HexNegs()"
        End If
    Next cntr
    'Return the value found
    cbaseSignedDec2Hex = HexStr
End Function
'Converts a hex string into a decimal value properly
Public Function cbaseSignedHex2Dec(ByVal HexStr As String) As Variant
    Dim cntr As Integer
    Dim sNibble As String
    Dim iNibble As Integer
    Dim retval As Variant
    Dim BinStr As String
    
    retval = CDec(0)
    
    'Loop through all of the nibbles and build a binary string
    For cntr = 0 To Len(HexStr) - 1
        'Get the first nibble
        sNibble = Right(HexStr, 1)
        'Trimm off the LSN
        HexStr = Left(HexStr, Len(HexStr) - 1)
        
        'Check the current character to see if it is a valid character
        Select Case Asc(sNibble)
            Case 48 To 57
            Case 65 To 70
            Case 97 To 102
            Case Else
                'If not raise an error and exit the function
                Err.Raise 13, "cbaseHexStr2Dec()", "Type mismatch - Invalid input string."
                Exit Function
        End Select
        
        'Convert the nibble to an integer
        iNibble = CInt("&h" & sNibble)
        
        'Convert the nibble to a binary string
        BinStr = cbaseDec2Bin(iNibble, 4) & BinStr
        
    Next cntr
    
    'Convert the binary string to a decimal value
    retval = cbaseSignedBinS2Dec(BinStr)
    
    'Return the calcualted integer value
    cbaseSignedHex2Dec = retval
End Function

'Pass it a binary string and it will return a hex string
Public Function cbaseBinStr2Hex(ByVal BinStr As String, ByVal HexLen As Integer) As String
    Dim RetStr As String
    Dim BinaryString As String
    Dim cntr As Integer
    Dim NumOfNibbles As Integer
    Dim BinStrLen As Integer
    Dim CurNibble As String
    
    'Get the length of the input string
    BinStrLen = Len(BinStr)
    
    'Check to see if the number of nibles are
    If BinStrLen Mod 4 <> 0 Then
        'Get the number of nibbles
        NumOfNibbles = Fix(BinStrLen / 4)
        'Add in leading 0's until the string is
        BinStr = String(((NumOfNibbles + 1) * 4) - BinStrLen, "0") & BinStr
        NumOfNibbles = NumOfNibbles + 1
    Else
        NumOfNibbles = BinStrLen / 4
    End If
    
    For cntr = 0 To NumOfNibbles - 1
        'Get the current Nibble
        CurNibble = Mid(BinStr, ((cntr * 4) + 1), 4)
        Select Case CurNibble
            Case "0000"
                RetStr = RetStr & "0"
            Case "0001"
                RetStr = RetStr & "1"
            Case "0010"
                RetStr = RetStr & "2"
            Case "0011"
                RetStr = RetStr & "3"
            Case "0100"
                RetStr = RetStr & "4"
            Case "0101"
                RetStr = RetStr & "5"
            Case "0110"
                RetStr = RetStr & "6"
            Case "0111"
                RetStr = RetStr & "7"
            Case "1000"
                RetStr = RetStr & "8"
            Case "1001"
                RetStr = RetStr & "9"
            Case "1010"
                RetStr = RetStr & "A"
            Case "1011"
                RetStr = RetStr & "B"
            Case "1100"
                RetStr = RetStr & "C"
            Case "1101"
                RetStr = RetStr & "D"
            Case "1110"
                RetStr = RetStr & "E"
            Case "1111"
                RetStr = RetStr & "F"
            Case Else
                'Error has occured
                MsgBox "Error: and invalid value was passed. Only binary strings can be passed to this function.", vbCritical + vbOKOnly, "cbaseBinStr2Hex: Type Missmatch"
        End Select
    Next cntr
    
    'Fix the output string to be the correct number of digits
    RetStr = String(HexLen - Len(RetStr), "0") & RetStr
    
    cbaseBinStr2Hex = RetStr
End Function