请问大家有没有十六进制转浮点数的VB源代码？

Question

能不能发给我一份啊，[email protected],谢谢。

Answer 1

http://topic.csdn.net/u/20080509/17/d135f60a-9533-421c-aabe-8d406199aa3b_2.html
Option Explicit
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Sub Command4_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 SubPrivate Sub Command5_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 SubPrivate Sub Form_Load() '11010000FC84D177
    Text1 = "" '1.79769313486231E+308"
    Text2 = "11010000FC84D177"
    Text3 = ""
End Sub

Answer 2

我看的算法是这个公式(-1)s * 2(Exponent-127) * 1.Mantissa。这个公式中先转成2进制的。

Answer 3

[Quote=引用 2 楼 yeosn 的回复:]
http://topic.csdn.net/u/20080509/17/d135f60a-9533-421c-aabe-8d406199aa3b_2.html
我刚学VB，能不能帮我解释一下？

Answer 4

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
                                    Destination As Any, _
                                    Source As Any, _
                                    ByVal Length As Long)Private Sub Form_Load()
    Dim strHex As String
    Dim sngTemp As Single
    Dim lngTemp As Long
    Dim dblTemp As Double
    Dim lngArray(1) As Long
    '==================== 初始化变量 ====================
    '---------- 单精度小数处理 ----------
    sngTemp = 45.99999                      '初始化一个小数
    MsgBox "原来的小数：" & CStr(sngTemp)
    
    '将单精度的小数转换成十六进制数
    CopyMemory lngTemp, sngTemp, 4          '将单精度类型的字节流同样复制到整数类型中
    strHex = Hex(lngTemp)                   '再将整数类型转换成16进制字符
    MsgBox "小数转换后的16进制字符:" & strHex
    
    '将16进制字符转换回单精度的小数
    sngTemp = 0                             '先清空，这样就不会误以为是上次设置的内容
    lngTemp = CLng("&H" & strHex)           '将16进制字符先转换成整数类型
    CopyMemory sngTemp, lngTemp, 4          '将整数类型的字节流同样复制到单精度类型中
    
    MsgBox "还原的小数：" & CStr(sngTemp)
    
    '---------- 双精度小数处理 ----------
    dblTemp = 88.999999999999
    MsgBox "原来的小数：" & CStr(dblTemp)   '初始化一个小数
    
    '将双精度的小数转换成十六进制数
    CopyMemory lngArray(0), dblTemp, 8
    strHex = Hex(lngArray(0))
    strHex = strHex & Hex(lngArray(1))
    
    MsgBox "小数转换后的16进制字符:" & strHex
    
    '将16进制字符转换回双精度的小数
    dblTemp = 0                             '先清空，这样就不会误以为是上次设置的内容
    lngArray(1) = CLng("&H" & Right(strHex, 8))
    lngArray(0) = CLng("&H" & Left(strHex, Len(strHex) - 8))
    
    CopyMemory dblTemp, lngArray(0), 8      '将字节流复制到双精度类型中
    
    MsgBox "还原的小数：" & CStr(dblTemp)
End Sub

Answer 5

是通过通讯接口得到十六进制表示的浮点数？实际上不需要计算。假如你传的是 Double 数，只需定义一个 Double 变量，将 Byte 数组 MemoryCopy 过去将好了。

Answer 6

这就很好说了，是ASCII编码的吧？转换成字符不就OK了？

Answer 7

本帖最后由 bcrun 于 2010-11-06 13:09:16 编辑

  

Answer 8

Option ExplicitPrivate Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
     ByRef Destination As Any, _
     ByRef Source As Any, _
     ByVal Length As Long)Function GetSingle(ByVal HexStr As String) As Single
    Dim sngOut As Single, tmpBytes(3) As Byte
    
    tmpBytes(3) = "&H" & Mid(HexStr, 1, 2)
    tmpBytes(2) = "&H" & Mid(HexStr, 3, 2)
    tmpBytes(1) = "&H" & Mid(HexStr, 5, 2)
    tmpBytes(0) = "&H" & Mid(HexStr, 7, 2)
    
    Call CopyMemory(ByVal VarPtr(sngOut), ByVal VarPtr(tmpBytes(0)), 4)
    GetSingle = sngOut
End FunctionPrivate Sub Command1_Click()
    MsgBox GetSingle("436b056f")
End Sub
简单点吧.调用GetSingle,输入字符串,输出单精度浮点数.输入的值一定要正确,因为函数里没有做任何意外保护.

Answer 9

斧正一下哈：
...
strHex = right("0000000"+Hex(lngTemp),8)                   '再将整数类型转换成16进制字符
...
strHex = right("0000000"+Hex(lngArray(0),8)
strHex = strHex & right("0000000"+Hex(lngArray(1)),8)
...

Answer 10

谢谢各位，谢谢SupermanKing的热情。正在堵在这牛角胡同里了。
问题解决！！呵呵