How to extract mantissa, exponent and sign data from an IEEE-754 64-bit (double) floating-point number in VBA? Thanks
Edit (after John Coleman comments). Before posting the original question, I have looked around for a solution and could only find how to do it in C (e.g. using structures with bit fields). Couldn't find anything for VBA. I have tried using VBA's bit operators (i.e. AND, OR, NOT, XOR) but this does not seem to give the expected result. For example, 1 expressed in single precision IEEE 32-bit floating-point is represented by
0 01111111 00000000000000000000000
where the first bit is for sign, the next 8 bits are for the (biased) exponent, and the last 23 bits are for the mantissa. Applying NOT to 1 should return
1 10000000 11111111111111111111111
which is -3.9999998 in decimal, but the following code in VBA returns -2, which is represented by
1 10000000 00000000000000000000000
x = Not 1!
Debug.Print x
I didn't see the point of posting this in my OP.
I think I've found the way to do this. The following function DoubleToBin returns a string of 64 bits representing an IEEE-754 double floating-point number. It uses a VBA "trick" to pass around raw data without using API routines (such as MemCopy (RtlMoveMemory)) by combining LSet with User Defined Types of the same size. And once we have the bit string we can extract all components from it.
Type TDouble
Value As Double
End Type
Type TArray
Value(1 To 8) As Byte
End Type
Function DoubleToArray(DPFloat As Double) As Variant
Dim A As TDouble
Dim B As TArray
A.Value = DPFloat
LSet B = A
DoubleToArray = B.Value
End Function
Function DoubleToBin(DPFloat As Double) As String
Dim ByteArray() As Byte
Dim BitString As String
Dim i As Integer
Dim j As Integer
ByteArray = DoubleToArray(DPFloat)
For i = 8 To 1 Step -1
j = 2 ^ 7
Do While j >= 1
If (ByteArray(i) And j) = 0 Then
BitString = BitString & "0"
Else
BitString = BitString & "1"
End If
j = j \ 2
Loop
Next i
DoubleToBin = BitString
End Function
How does it work on here - do I now accept my own answer?
This is a modification of Confounded's excellent answer. I modified their function to be use the built-in function Hex rather than bit-wise operations to get the to the bit patterns, made it be able to handle both single and double precision flexibly, and return either the results in either hex (the default) or binary:
Type TDouble
Value As Double
End Type
Type TSingle
Value As Single
End Type
Type DArray
Value(1 To 8) As Byte
End Type
Type SArray
Value(1 To 4) As Byte
End Type
Function DoubleToArray(DPFloat As Double) As Variant
Dim A As TDouble
Dim B As DArray
A.Value = DPFloat
LSet B = A
DoubleToArray = B.Value
End Function
Function SingleToArray(SPFloat As Single) As Variant
Dim A As TSingle
Dim B As SArray
A.Value = SPFloat
LSet B = A
SingleToArray = B.Value
End Function
Function HexToBin(hDigit As String) As String
Select Case hDigit
Case "0": HexToBin = "0000"
Case "1": HexToBin = "0001"
Case "2": HexToBin = "0010"
Case "3": HexToBin = "0011"
Case "4": HexToBin = "0100"
Case "5": HexToBin = "0101"
Case "6": HexToBin = "0110"
Case "7": HexToBin = "0111"
Case "8": HexToBin = "1000"
Case "9": HexToBin = "1001"
Case "A": HexToBin = "1010"
Case "B": HexToBin = "1011"
Case "C": HexToBin = "1100"
Case "D": HexToBin = "1101"
Case "E": HexToBin = "1110"
Case "F": HexToBin = "1111"
End Select
End Function
Function ByteToString(B As Byte, Optional FullBinary As Boolean = False)
Dim BitString As String
BitString = Hex(B)
If Len(BitString) < 2 Then BitString = "0" & BitString
If FullBinary Then
BitString = HexToBin(Mid(BitString, 1, 1)) & HexToBin(Mid(BitString, 2, 1))
End If
ByteToString = BitString
End Function
Function FloatToBits(float As Variant, Optional FullBinary As Boolean = False) As String
Dim ByteArray() As Byte
Dim BitString As String
Dim i As Integer, n As Integer
Dim x As Double, y As Single
If TypeName(float) = "Double" Then
n = 8
x = float
ByteArray = DoubleToArray(x)
ElseIf TypeName(float) = "Single" Then
n = 4
y = float
ByteArray = SingleToArray(y)
Else
FloatToBits = "Error!"
Exit Function
End If
For i = n To 1 Step -1
BitString = BitString & ByteToString(ByteArray(i), FullBinary)
Next i
FloatToBits = BitString
End Function
Here is a test:
Sub test()
Dim x As Single, y As Double
x = Application.WorksheetFunction.Pi()
y = Application.WorksheetFunction.Pi()
Debug.Print FloatToBits(x)
Debug.Print FloatToBits(x, True)
Debug.Print FloatToBits(y)
Debug.Print FloatToBits(y, True)
End Sub
Output:
40490FDB
01000000010010010000111111011011
400921FB54442D18
0100000000001001001000011111101101010100010001000010110100011000
When I feed 400921FB54442D18 into this online tool I get back 3.141592653589793, which makes perfect sense.
Somewhat curiously, when I apply this to 10.4 I get
0100000000100100110011001100110011001100110011001100110011001101
which differs in the final place from the example in this excellent article on floats in Excel VBA. Both versions round to 10.4 (to many, many places). I don't quite know what to make of the discrepancy.
Partial Answer:
VBA bitwise operators are designed to work with integer or long data. Consider the following:
Sub test()
Dim x As Single, y As Single
x = 1#
y = Not x
Debug.Print y
Debug.Print TypeName(Not x)
End Sub
Output:
-2
Long
The first output line is the observed weirdness. The second line is the explanation of this weirdness. Evidently, x is converted to a long before being fed into Not. Interestingly, the following C program also prints -2:
int main(void){
int x,y;
x = 1;
y = ~x;
printf("%d\n",y);
return 0;
}
(gcc uses 32 bit ints on my machine, so int here is equivalent to Long in VBA)
It should be possible to obtain what you want, but bitwise operators are not the way to go.
来源：https://stackoverflow.com/questions/31909506/extract-mantissa-exponent-and-sign-data-from-ieee-754-double-in-vba