vb将单精度转换为4个字符串.docx

1、vb将单精度转换为4个字符串Option Explicit Private Declare Sub CopyMemory Lib kernel32 Alias RtlMoveMemory (Destination As Any, Source As Any, ByVal Length As Long) Private Sub cmdSinHex_Click() Text3 = Dim i As Integer Dim hexData As String Dim a As Single Dim Buffer(3) As Byte a = Val(Text1) CopyMemory Buffer(

2、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 For i = 1 To Len(hexData) Step 2 Text3 = Text3 & ChrW(Val(&H & Mid(hexData, i, 2) & Next End Sub Private Sub Form_Load() Text1 = Text2 = Text

3、3 = End Sub 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)

4、 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

5、 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 下列代码演

6、示了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(Text

7、1) 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 sin

8、Str = 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 个字节)浮点数值的形

9、式,它的范围在负数的时候是从 -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为尾数 Do

10、uble(双精度浮点型)变量存储为 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进制小数尾

11、值 即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

12、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(

13、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)

14、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 El

15、seIf 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 = 0, 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

16、, Mid(sHex, i, 1), 4) Next i HexToBin = sBin bindata = sBin End Function Public Function BinToHex(ByVal sBin As String) As String Const s1 = 0, 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

17、, 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

18、 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(binda

19、ta, 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) * (

20、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

21、 & 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 = 0, s2 = 0125A4936DB7FEC8 Dim i As Integer, sBin As String sHex = UCase(sHex) For i = 1 To Len(sHex) sBin

22、= 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 = 0, 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)

23、 Step 4 sHex = sHex & Mid(s2, InStr(1, s1, Mid(sBin, i, 4), 1) Next i BinToHex = sHex End Function 字符串类型转化为单精度类型 Private Sub Command1_Click() s = 123.456 d = CSng(s) Print d End Sub 本来浮点数是这样转化的,但是好象显示的结果和你的有点不同,我不知道什么原因 VB code Private Declare Sub CopyMemory Lib kernel32 Alias RtlMoveMemory (Destination As Any, Source As Any, ByVal Length As Long) Public Function SngToLng(ByVal Value As Single) As Long CopyMemory SngToLng, Value, 4 End Function Public Function LngToSng(ByVal Value As Long) As Single CopyMemory LngToSng, Value, 4 End Function