VB的浮点数处理

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/39624959.html

http://zhidao.baidu.com/question/39100439.html

http://topic.csdn.net/u/20080108/14/67783c1e-1a7e-4613-904c-dda5e08a380b.html