I doubt this code will have much utility, but it is a nice teaching tool. Basically, the two notable functions are:

- CBinStrFromSng
- CSngFromBinStr

CBinStrFromSngtakes any Single and converts it to a String with a floating-point binary (base 2) number in it. It is theexactbase 2 number represented in the IEEE Single. Since the IEEE storage of a Single is purely a base 2 operation, this is possible.

TheCSngFromBinStrfunction is also provided for completeness. However, thisCSngFromBinStrfunction does have caveats for its input. So long as it's an output from theCBinStrFromSngfunction, it'll work perfectly. Read the comments to thisCSngFromBinStrfunction for more details on the input criteria. Briefly, the string must be either 1s, 0s, one period, and possibly a leading - sign. Anything else will cause it to error (other than the special NaN and infinity conditions).

There is also a loop (form_click event) included which illustrates some of the problems (bit jiggling) that will sometimes take place when we do base 2 to base 10 (and back) conversions.

Code:As a quick example, "0.01011001101000101010011" will convert to 0.3501381! in base 10. However, "0.0101100110100010101001101" will also convert to 0.3501381! in base 10.

There are also cases in the other direction, where a base 10 number can't find an ideal representation in base 2. Try typing the following code into some code somewhere and watch what happens:

Code:Dim n As Single n = 1E-40!

The IDE knows that there is no good base 2 (IEEE Single) representation for 1E-40!.

Here's a functioning piece of code (for a Form1) with all the supporting functions. You may want to change some of these to Public if you ever intend to use them in a wider scope.

Code:Option Explicit ' Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless. ' Private Sub Form_Click() 'Debug.Print " Binary Number: " & CBinStrFromSng(1!) 'Debug.Print " Binary Number: " & CBinStrFromSng(2!) 'Debug.Print " Binary Number: " & CBinStrFromSng(0.000001!) 'Debug.Print " Binary Number: " & CBinStrFromSng(1.175495E-38!) ' Smallest possible non-subnormal number. 'Debug.Print " Binary Number: " & CBinStrFromSng(1.401298E-45!) ' Smallest possible number. 'Debug.Print " Binary Number: " & CBinStrFromSng(3.402823E+38!) ' Largest possible number. ' Largest binary number we can deal with. We can specify more precision and it'll be ignored. If we specify more bits, it'll overflow. ' Changing the last one or two least-significant 1s may not change the resulting base-10 number. 'Debug.Print CSngFromBinStr("11111111111111111111111100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.0") ' Smallest binary number (sub-normal) we can deal with, although slightly larger base-2 numbers will result in the same base-10 number: 1.401298E-45! 'Debug.Print CSngFromBinStr("0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") Dim s2 As String Dim v3 As Variant Dim n1 As Single Dim n2 As Single Dim n3 As Single Dim cnt As Long Dim iLen As Long Randomize 1234 Do ' The following won't ever error because Rnd returns <1, and also, it doesn't get down into the sub-normal so as to no bias the results. ' Therefore, it will never overflow or underflow. ' Max will be around 600000, and Min will be around 0.000002, both well within the range of a Single. ' n1 = Rnd / (Rnd + 0.000001!) ' This is a PURE base-2 operation whereby the smallest increments of base-2 numbers could be calculated, and not limited by base-10 conversions. ' s2 = CStr(n1) ' No problem here, although multiple n1 values may resolve to the same s2 value. n2 = CSng(s2) ' This may NOT go back to the original n1 because, in certain cases, multiple binary numbers can represent the same base-10 number, so one is chosen (but maybe not the same one as the original). ' v3 = CDec(n1) ' No problem here, but this works much like CStr() in that we must get from a base-2 number to a base-10 number. n3 = CSng(v3) ' Again, this may NOT go back to the original n1 ... as explained above for n2. ' If (n1 <> n2) Or (n1 <> n3) Then ' IEEE numbers are compared as a base-2 number, so we may find differences from the base-10 to base-2 conversions above. iLen = Len("Base 10 of n1: " & CStr(n1)) Debug.Print "--------------------------------------------------------" Debug.Print " Original: Base 10 of n1: " & CStr(n1) & Space$(32 - iLen) & "Base 2 of n1: " & CBinStrFromSng(n1) Debug.Print "CSng(CStr): Base 10 of n2: " & CStr(n2) & Space$(32 - iLen) & "Base 2 of n2: " & CBinStrFromSng(n2) Debug.Print "CSng(CDec): Base 10 of n3: " & CStr(n3) & Space$(32 - iLen) & "Base 2 of n3: " & CBinStrFromSng(n3) cnt = cnt + 1 If cnt = 10 Then Exit Do End If Loop Debug.Print "--------------------------------------------------------" Debug.Print "Found 10 with jiggled bits." End Sub Private Function CBinStrFromSng(ByVal n As Single) As String ' Double-check site: https://www.exploringbinary.com/binary-converter/ Dim iMantissa As Long Dim iExponent As Long Dim iSign As Long Dim iFull As Long ' GetMem4 n, iFull ' iMantissa = &H7FFFFF And iFull ' Mask off the mantissa bits. It's in the low-order bits so no shifting needed. iExponent = &H7F800000 And iFull ' Mask off the exponent bits. iExponent = iExponent \ &H800000 ' Shift exponent down to low-order bits. If (iFull And &H80000000) <> 0& Then iSign = 1& Else iSign = 0& ' Get the sign bit. ' 'If bShowDebugging Then ' Debug.Print "--------------------------------------------------------" ' Debug.Print "Base 10 of Single: " & CStr(n) ' Debug.Print " Memory of Single: " & Long2Binary(iFull) ' Debug.Print " Mantissa: " & Right$(Long2Binary(iMantissa), 23) ' Debug.Print " Exponent: " & Right$(Long2Binary(iExponent), 8) ' Debug.Print " Exponent: " & iExponent ' Debug.Print " Sign: " & Right$(Long2Binary(iSign), 1) 'End If ' ' Deal with zero. If iExponent = 0& And iMantissa = 0& Then If iSign Then CBinStrFromSng = "-0.0" Else CBinStrFromSng = "0.0" End If Exit Function End If ' ' Deal with NaN and infinity. If iExponent = &HFF& Then If iMantissa = 0& Then If iSign Then CBinStrFromSng = "-INF" Else CBinStrFromSng = "INF" End If Else CBinStrFromSng = "NaN" ' There is also the possibility of a negative NaN, but that typically isn't used. ' In some cases, a NaN can have different meanings. These meanings are coded into the Mantissa. ' However, these distinctions aren't parsed here. End If Exit Function End If ' ' Deal with subnormal numbers. If iExponent = 0& Then ' The implicit 24th bit isn't used in this case. CBinStrFromSng = "0." & String$(126, "0") & Right$(Long2Binary(iMantissa), 23) If iSign Then CBinStrFromSng = "-" & CBinStrFromSng ' Deal with sign bit. Exit Function End If ' ' Regular floating point from here down. iMantissa = &H800000 Or iMantissa ' Add the implicit 24th bit to mantissa. CBinStrFromSng = String$(126, "0") & Right$(Long2Binary(iMantissa), 24) & String$(128, "0") ' Add leading and following zeros. CBinStrFromSng = Left$(CBinStrFromSng, iExponent) & "." & Mid$(CBinStrFromSng, iExponent + 1) ' Insert the decimal. TrimZeros CBinStrFromSng ' Trim zeros. If iSign Then CBinStrFromSng = "-" & CBinStrFromSng ' Deal with sign bit. End Function Private Function CSngFromBinStr(ByVal s As String) As Single ' The incoming string MUST be in exactly the same format as the output from the CBinStrFromSng() function. ' Special values are: "-INF", "INF", & "NaN". ' All other values can have a leading minus sign (or nothing for positive). ' They must also have at least one binary number both before and after the decimal point. ' Dim iMantissa As Long Dim iExponent As Long Dim iSign As Long Dim iFull As Long Dim t As String Dim i As Long ' ' Deal with special cases first. If s = "-INF" Then iFull = &HFF800000 GetMem4 iFull, CSngFromBinStr Exit Function End If If s = "INF" Then iFull = &H7F800000 GetMem4 iFull, CSngFromBinStr Exit Function End If If s = "NaN" Then ' We don't cover all the NaN conditions. ' In this one case, the precise same bit-pattern that was in the Single's memory might not return. ' In other words, the mantissa is always just set to all ones, where it may not have originally been. ' Also, the sign bit is left off, where it may have originally been on. iFull = &H7FFFFFFF GetMem4 iFull, CSngFromBinStr Exit Function End If ' ' Get the sign. If Left$(s, 1) = "-" Then iSign = 1 s = Mid$(s, 2) End If ' ' Make sure it's all 1s, 0s, and decimal point. t = Replace(s, "1", "0") t = Replace(t, ".", "0", , 1) If t <> String$(Len(t), "0") Then Error 13 ' Type mismatch. Exit Function End If ' ' Make sure it's properly formatted. i = InStr(s, ".") If i < 2 Or i >= Len(s) Then Error 13 ' Type mismatch. Exit Function End If ' ' See if it's zero. If InStr(s, "1") = 0 Then If iSign Then iFull = iFull Or &H80000000 GetMem4 iFull, CSngFromBinStr Exit Function End If ' v ' The following is just a precaution for numbers like "00.00001" TrimZeros s ' ' See if it's subnormal. If Left$(s, 128) = "0." & String$(126, "0") Then s = Mid$(s, 129) s = Left$(s & String$(23, "0"), 23) ' For this, we must have precisely 23 bits. If not, add them to the end, indicating zeros for precision. ' As a note, this could be 23 zeros, which is fine (i.e., too much small precision provided). ' It'll just result in a zero mantissa and exponent, which is the same as the above zero. iFull = Binary2Long(s) ' The mantissa is in the low-order bits, so we're good to go. The exponent bits stay zeros. If iSign Then iFull = iFull Or &H80000000 GetMem4 iFull, CSngFromBinStr Exit Function End If ' ' It's a normal non-zero floating point from here down. ' ' Is it less than 1. If Left$(s, 2) = "0." Then s = Mid$(s, 3) ' Strip leading "0.". iExponent = 126& ' For negative, exponent starts here. Do If Left$(s, 1) = "1" Then Exit Do ' See if we found the implicit 1. s = Mid$(s, 2) ' Strip the zero. iExponent = iExponent - 1 ' Keep incrementing the exponent until we hit a 1. Loop Else i = InStr(s, ".") ' Check for an overflow. If i >= 130 Then Error 6 ' Overflow error. Exit Function End If iExponent = i + 125& ' Can't exceed 254, as 255 (&hFF) has special meaning. s = Left$(s, i - 1) & Mid$(s, i + 1) ' Remove the decimal point. End If ' ' The following is the same for <1 or >1 for normal non-zero floating point. ' The iExponent is set (in low order bits), and s is a binary number with 1 as high order bit. s = Mid$(s, 2) ' Strip the implicit 1. s = Left$(s & String$(23, "0"), 23) ' Mantissa is always exactly 23 bits, so fill in trailing zeros. This also strips any binary precision we can't deal with. iMantissa = Binary2Long(s) ' This gives us our mantissa. iExponent = iExponent * &H800000 ' Offset the exponent bits to where they belongs (23 bits out). iFull = iExponent Or iMantissa ' Combine exponent and mantissa. If iSign Then iFull = iFull Or &H80000000 GetMem4 iFull, CSngFromBinStr End Function Private Sub TrimZeros(s As String) Do If Left$(s, 1) <> "0" Then Exit Do If Mid$(s, 2, 1) = "." Then Exit Do s = Mid$(s, 2) Loop Do If Right$(s, 1) <> "0" Then Exit Do If Right$(s, 2) = ".0" Then Exit Do s = Left$(s, Len(s) - 1) Loop End Sub Private Function Long2Binary(ByVal l As Long) As String ' This is the 2s-compliment of the long, in binary. If positive, it's a true binary number of the long's value. ' Returns a 32 character string of 1s and 0s representing the memory of the Long. ' The return is NON-signed, with the sign bit being in the high-order bit. ' Dim k As Long ' ' The sign bit is a bit trickier. Long2Binary = Format$(Abs((l And &H80000000) = &H80000000)) ' All others, just check the bit. k = &H40000000 Do Long2Binary = Long2Binary & Format$(Abs((l And k) <> 0)) If k = 1& Then Exit Do k = k \ 2& Loop End Function Private Function Binary2Long(ByVal s As String) As Long ' This is the 2s-compliment of the long, in binary. If positive, it's a true binary number of the long's value. ' The incoming string must be nothing but 1s and 0s, and no longer than what will fit into a Long. ' It is NON-signed, with the sign bit represented as the high-order bit. ' 11111111111111111111111111111111 (32 bits) is the largest possible number. ' Anything not 1 will be interpreted as 0. ' An empty string returns 0. ' Dim iSign As Long Dim j As Long Dim k As Long ' If Len(s) > 32 Then Error 13 ' Type mismatch. Exit Function End If ' ' Grab sign bit. If Len(s) = 32 And Left$(s, 1) = "1" Then iSign = 1 s = Mid$(s, 2) End If ' ' Build return. j = -1 For k = Len(s) To 1 Step -1 j = j + 1 If Mid$(s, k, 1) = "1" Then Binary2Long = Binary2Long Or (2 ^ j) End If Next k ' If iSign Then Binary2Long = Binary2Long Or &H80000000 End Function

With relative ease, this could also be reworked to deal with IEEE Double encoding as well, since all the concepts are covered. It would just be a matter of changing around some of the constants to deal with the different size mantissa and exponent.

Enjoy,

Elroy

Note: Some people may be more familiar with the term "Significand". I tend to use the term "Mantissa" as that's how I learned it. They have the same meaning. They're an integer (of some number of bits) that carry the significant digits of a number (without respect to where the decimal point goes).