浮点数转换

Private Sub Command1_Click()
Dim k As Integer
Dim i As Integer
Dim j As Integer
Dim S As Integer
Dim SS As Integer
Dim E As Integer
Dim M As Long

Dim d As Double
Dim n As Integer
Dim h As Integer
Dim l As Integer

Dim buff(7) As Byte '接收到的数据
buff(0) = Asc("B")
buff(1) = Asc("2")
buff(2) = Asc("D")
buff(3) = Asc("2")
buff(4) = Asc("D")
buff(5) = Asc("2")
buff(6) = Asc("5")
buff(7) = Asc("8")

Dim a(15) As Byte
For i = 0 To 15
a(i) = i
Next i


Dim b(7) As Byte '存放十进制的数
For j = 0 To 7

If buff(j) >= 48 And buff(j) <= 57 Then
k = buff(j) - 48
b(j) = a(k)
ElseIf buff(j) >= 65 And buff(j) <= 70 Then
k = buff(j) - 65
b(j) = a(k + 10)
Else
Exit Sub
End If

Next j

Dim c(3) As Long
For n = 0 To 6 Step 2 '八字节转换成四字节

c(n / 2) = ((b(n) And &H7F) * (2 ^ 4)) Or (b(n + 1) And &H7F)

Next n
'浮点数运算
S = c(0) \ 2 ^ 7
If S = 1 Then
SS = -1
Else
SS = 1
End If

E = ((c(0) And &H7F) * 2) Or ((c(1) And &H80) \ 2 ^ 7)

M = ((c(1) And &HFFFFFF) * 2 ^ 16 And &H7FFFFF) Or ((c(2) And &HFFFFFF) * 2 ^ 8) Or ((c(3) And &HFFFFFF))

d = SS * 2 ^ (E - 127) * (M / (2 ^ 23) + 1)
Text1.Text = d
Text2.Text = SS
Text3.Text = E
Text4.Text = M
End Sub




Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Command1_Click() '双精度
Dim a As Double
Dim buff() As Byte
ReDim buff(7)
a = 12345.6789
CopyMemory buff(0), a, 8 '将Double型变量转为字节数组
Dim i As Long
For i = 0 To UBound(buff)
Debug.Print buff(i)
Next
Dim b As Double
CopyMemory b, buff(0), 8 '将字节数组转为Double型变量
Debug.Print b
End Sub

Private Sub Command2_Click() '单精度
Dim a As Single
Dim buff() As Byte
ReDim buff(3)
a = 12345.6789
Debug.Print a
CopyMemory buff(0), a, 4 '将Double型变量转为字节数组
Dim i As Long
For i = 0 To UBound(buff)
Debug.Print buff(i)
Next
Dim b As Single
CopyMemory b, buff(0), 4 '将字节数组转为Double型变量
Debug.Print b
End Sub
Sub 按钮2_单击()
Dim a As Single
Dim HexStr As String

Dim buff() As Byte
ReDim buff(3)
a = 5.53333
Debug.Print a
CopyMemory buff(0), a, 4 '

将Double型变量转为字节数组

HexStr = Hex(buff(3)) & Hex(buff(2)) & Hex(buff(1)) & Hex(buff(0))
Debug.Print HexStr
Dim b As Single
CopyMemory b, buff(0), 4 '将字节数组转为Double型变量

Debug.Print "b=" & b
Debug.Print "float=" & Hex2Float(HexStr)
End Sub
Function Hex2Float(Hex8Float As String) As Double
Dim StrHex As String
Dim valunlong
Dim SignFlag As Boolean
Dim Exp8 As String
Dim Exp8Int As Integer
Dim Fraction23 As String
Dim Fraction23Int As Integer
Dim FloatVal As Single

StrHex = Trim(Hex8Float)
Exp8 = Left(StrHex, 2)
If Val("&H" & Exp8) > 127 Then '计算高7位的值
Exp8Int = (Val("&H" & Exp8) - 128) * 2
SignFlag = True
Else
Exp8Int = Val("&H" & Exp8) * 2
SignFlag = False
End If

If Val("&H" & Mid(StrHex, 3, 2)) > 127 Then Exp8Int = Exp8Int + 1 '加上最低位的值
Exp8Int = Exp8Int - 127

'计算后12小数和整数部分的和
FloatVal = Val("&H" & Right(StrHex, 3)) * 2 ^ (Exp8Int - 23) + 2 ^ Exp8Int
Fraction23Int = Val("&H" & Mid(StrHex, 3, 3))

'计算前11位小数的和
If Fraction23Int > 2047 Then

FloatVal = FloatVal + (Fraction23Int - 2048) * 2 ^ (Exp8Int - 11)
Else
FloatVal = FloatVal + Fraction23Int * 2 ^ (Exp8Int - 11)

End If

If SignFlag Then FloatVal = -FloatVal '判断符号位

Hex2Float = FloatVal

End Function