VB串口通信中经常会遇到10进制浮点数转为多字节Byte数据类型的情况，以及在接收后需转为10进制浮点数需求。
VB有专门的API函数CopyMemory能处理2-10进制浮点数转换和10-2进制浮点数转换。
下列代码演示了10进制Single（单精度浮点型转为16进制字符显示的浮点数和其相反运算：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub BinToSin_Click()
Dim sinStr As String
Dim sinSj As Single
Dim Buffer(3) As Byte
Dim i As Integer
sinStr = Text2
For i = 1 To Len(Text2) Step 2
Buffer((7 - i) / 2) = Val("&H" & Mid(sinStr, i, 2))
Next
CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(Buffer(0)), 4
Text3 = sinSj
End Sub
Private Sub SinToBin_Click()
Dim i As Integer
Dim hexData As String
Dim a As Single
Dim Buffer(3) As Byte
a = Val(Text1)
CopyMemory Buffer(0), a, 4
For i = 0 To 3
If Len(Hex(Buffer(i))) = 1 Then
hexData = "0" & Hex(Buffer(i)) + hexData
Else
hexData = Hex(Buffer(i)) + hexData
End If
Next
Text2 = hexData
End Sub
下列代码演示了10进制Double（双精度浮点型）转为16进制字符显示的浮点数和其相反运算：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub cmdDoubHex_Click()
Dim i As Integer
Dim hexData As String
Dim a As Double
Dim Buffer(7) As Byte
a = Val(Text1)
CopyMemory Buffer(0), a, 8
For i = 0 To 7
If Len(Hex(Buffer(i))) = 1 Then
hexData = "0" & Hex(Buffer(i)) + hexData
Else
hexData = Hex(Buffer(i)) + hexData
End If
Next
Text2 = hexData
End Sub
Private Sub cmdHexDec_Click()
Dim sinStr As String
Dim sinSj As Double
Dim bytes(7) As Byte
Dim i As Integer
sinStr = Text2
For i = 1 To Len(Text2) Step 2
bytes((15 - i) / 2) = Val("&H" & Mid(sinStr, i, 2))
Next
CopyMemory ByVal VarPtr(sinSj), ByVal VarPtr(bytes(0)), 8
Text3 = sinSj
End Sub
但从中无法了解它是如何进行运算处理的。以下通过对Single（单精度浮点型）和Double（双精度浮点型）在内存的储存方式进行分析。
VB的Single 数据类型
Single（单精度浮点型）变量存储为 IEEE 32 位（4 个字节）浮点数值的形式，它的范围在负数的时候是从 -3.402823E38 到 -1.401298E-45，而在正数的时候是从 1.401298E-45 到 3.402823E38。Single 的类型声明字符为感叹号 (!)。
在内存以32位二进制形式存在:
XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX
第1位为符号位
第2-9位为阶码位
第10-32位为2进制小数尾值
即F2 ^ n * 1. XXXXXXX XXXXXXXX XXXXXXXX
其中
F为正号或负号(首为为0正数,首位为1负数
n为2-9位组成的BYTE数据值
XXXXXXX XXXXXXXX XXXXXXXX为尾数
Double（双精度浮点型）变量存储为 IEEE 64 位（8 个字节）浮点数值的形式，它的范围在负数的时候是从 -1.79769313486232E308 到 -4.94065645841247E-324，而正数的时候是从 4.94065645841247E-324 到 1.79769313486232E308。Double 的类型声明字符是数字符号 (#)。
在内存以64位二进制形式存在:
XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX
第1位为符号位
第2-12位为阶码位
第13-64位为2进制小数尾值
即F2 ^ n * 1. XXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX
其中
F为正号或负号(首为为0正数,首位为1负数
n为2-12位组成的BYTE数据值
XXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX XXXXXXXX为尾数
以下代码是基于前叙述的Single（单精度浮点型）在内存的储存方式进行分析后作出的2-10进制浮点数运算：
Option Explicit
Dim hexData As String
Dim i As Single
Dim bindata As String
Dim zs As String * 8
Dim zssz As String
Dim xs As String * 23
Dim xs_js() As Double
Dim xs_hj As Double
Dim sinData As Single
Dim sHex As String
Dim sBin As String
Dim fh As String
Private Sub Command1_Click()
Dim fh As String
sHex = Text1
HexToBin (sHex)
fh = Mid(bindata, 1, 1) '取符号
zs = Mid(bindata, 2, 8) '取指数阶码
xs = Mid(bindata, 10, 23) '取2进制小数
xs_hj = 0
zssz = BinToHex(zs)
ReDim xs_js(1 To 23)
For i = 1 To 23
xs_js(i) = Val(Mid(xs, i, 1))
xs_hj = xs_hj + xs_js(i) / (2 ^ (i))
Next
If zs <> "00000000" Then
Shape1.FillColor = vbGreen
If fh = 0 Then
sinData = 2 ^ (Val("&H" & zssz) - 127) * (1 + xs_hj)
ElseIf fh = 1 Then
sinData = -2 ^ (Val("&H" & zssz) - 127) * (1 + xs_hj)
End If
ElseIf sHex = "00000000" Then
sinData = 0
Shape1.FillColor = vbGreen
ElseIf zs = "00000000" Then '处理在0到1.175494351E-38及
Shape1.FillColor = vbRed '0到-1.175494351E-38间的浮点数
If fh = 0 Then
sinData = 2 ^ (Val("&H" & zssz) - 126) * xs_hj
ElseIf fh = 1 Then
sinData = -2 ^ (Val("&H" & zssz) - 126) * xs_hj
End If
End If
Text2 = sinData
End Sub
Public Function HexToBin(ByVal sHex As String) As String
Const s1 = "0000101001101111000", s2 = "0125A4936DB7FEC8"
Dim i As Integer, sBin As String
sHex = UCase(sHex)
For i = 1 To Len(sHex)
sBin = sBin & Mid(s1, InStr(1, s2, Mid(sHex, i, 1)), 4)
Next i
HexToBin = sBin
bindata = sBin
End Function
Public Function BinToHex(ByVal sBin As String) As String
Const s1 = "0000101001101111000", s2 = "0125A4936DB7FEC8"
Dim i As Integer, sHex As String
sBin = String(3 - (Len(sBin) - 1) Mod 4, "0") & sBin
For i = 1 To Len(sBin) Step 4
sHex = sHex & Mid(s2, InStr(1, s1, Mid(sBin, i, 4)), 1)
Next i
BinToHex = sHex
End Function
以下代码是基于前叙述的Double（双精度浮点型）在内存的储存方式进行分析后作出的2-10进制浮点数运算：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Dim hexData As String
Dim i As Single
Dim bindata As String
Dim zs As String '* 8
Dim zssz As String
Dim xs As String '* 23
Dim xs_js() As Double
Dim xs_hj As Double
Dim sinData As Double
Dim sHex As String
Dim sBin As String
Private Sub Command2_Click()
Dim fh As String
sHex = Text2
HexToBin (sHex)
fh = Mid(bindata, 1, 1)
zs = Mid(bindata, 2, 11) '取指数
xs = Mid(bindata, 13, 52) '取2进制小数
xs_hj = 0
zs = "0" & zs
zssz = BinToHex(zs)
ReDim xs_js(1 To 52)
For i = 1 To 52
xs_js(i) = Val(Mid(xs, i, 1))
xs_hj = xs_hj + xs_js(i) / (2 ^ (i))
Next
If zs <> "000000000000" Then
Shape1.FillColor = vbGreen
If fh = 0 Then
sinData = 2 ^ (Val("&H" & zssz) - 1023) * (1 + xs_hj)
ElseIf fh = 1 Then
sinData = -2 ^ (Val("&H" & zssz) - 1023) * (1 + xs_hj)
End If
ElseIf sHex = "00000000" Then
sinData = 0
Shape1.FillColor = vbGreen
ElseIf zs = "000000000000" Then '处理在0到2.2250738585072E-308及
Shape1.FillColor = vbRed '0到-2.2250738585072E-308间的浮点数
If fh = 0 Then
sinData = 2 ^ (Val("&H" & zssz) - 1022) * xs_hj
ElseIf fh = 1 Then
sinData = -2 ^ (Val("&H" & zssz) - 1022) * xs_hj
End If
End If
Text3 = sinData
End Sub
Public Function HexToBin(ByVal sHex As String) As String
Const s1 = "0000101001101111000", s2 = "0125A4936DB7FEC8"
Dim i As Integer, sBin As String
sHex = UCase(sHex)
For i = 1 To Len(sHex)
sBin = sBin & Mid(s1, InStr(1, s2, Mid(sHex, i, 1)), 4)
Next i
HexToBin = sBin
bindata = sBin
End Function
Public Function BinToHex(ByVal sBin As String) As String
Const s1 = "0000101001101111000", s2 = "0125A4936DB7FEC8"
Dim i As Integer, sHex As String
sBin = String(3 - (Len(sBin) - 1) Mod 4, "0") & sBin
For i = 1 To Len(sBin) Step 4
sHex = sHex & Mid(s2, InStr(1, s1, Mid(sBin, i, 4)), 1)
Next i
BinToHex = sHex
End Function
参考资料：
http://zhidao.baidu.com/question/39100439.html
http://topic.csdn.net/u/20080108/14/67783c1e-1a7e-4613-904c-dda5e08a380b.html
