IEEE 754 浮点数16进制相互转换的问题

[ccbbcc]

请问这个转换用VB如何实现？谢谢！

[笨狗先飞]

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function SngToStr(ByVal F As Single) As String
    Dim Data() As Byte, I As Integer, C As Integer, CH As String
    On Error GoTo hErr
    SngToStr = ""
    C = LenB(F) - 1
    ReDim Data(C)
    CopyMemory Data(0), F, LenB(F)
    For I = 0 To C
        CH = Hex(Data(I))
        If Len(CH) = 1 Then CH = "0" & CH
        SngToStr = CH & SngToStr
    Next
hErr:
End Function

[笨狗先飞]

Public Function StrToSng(ByVal Data As String) As Single
    Dim I As Integer, C As Integer, R() As Byte
    On Error GoTo hErr
    StrToSng = 0
    C = LenB(StrToSng) - 1
    ReDim R(C)
    For I = 0 To C
        R(C - I) = CByte("&H" & Mid(Data, I * 2 + 1, 2))
    Next
    CopyMemory StrToSng, R(0), LenB(StrToSng)
hErr:
End Function

[ccbbcc]

引用 2 楼 笨狗先飞 的回复:

Public Function StrToSng(ByVal Data As String) As Single
    Dim I As Integer, C As Integer, R() As Byte
    On Error GoTo hErr
    StrToSng = 0
    C = LenB(StrToSng) - 1
    ReDim R(C)
    For I = 0 To C
        R(C - I) = CByte("&H" & Mid(Data, I * 2 + 1, 2))
    Next
    CopyMemory StrToSng, R(0), LenB(StrToSng)
hErr:
End Function

谢谢！

好像不对幺。

[脆皮大雪糕]

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Form_Load()
    Dim InA As Single
    '调用示例
    InA = 5.8868464408377E-39
    Debug.Print InA, Dec2Hex(InA), Hex2Dec(Dec2Hex(InA))
    InA = -5.8868464408377E-39
    Debug.Print InA, Dec2Hex(InA), Hex2Dec(Dec2Hex(InA))
End Sub
'转换为十六进制
Public Function Dec2Hex(InputNumber As Single) As String
    Dim Tran() As Byte
    Dim I As Integer
    ReDim Tran(LenB(InputNumber) - 1)
    CopyMemory Tran(0), InputNumber, LenB(InputNumber)
    For I = LBound(Tran) To UBound(Tran)
        Dec2Hex = Right("00" & Hex(Tran(I)), 2) & Dec2Hex
    Next
End Function
'转换为单精度浮点数
Public Function Hex2Dec(InputHex As String) As Single
    Dim Tran() As Byte
    Dim I As Integer
    ReDim Tran(LenB(InputHex) / 4 - 1)
    For I = LBound(Tran) To UBound(Tran)
        Tran(I) = Val("&H" & (Mid(InputHex, (UBound(Tran) - I) * 2 + 1, 2)))
    Next
    CopyMemory Hex2Dec, Tran(0), UBound(Tran) + 1
End Function

[笨狗先飞]

引用 3 楼 ccbbcc 的回复:

[quote=引用 2 楼 笨狗先飞 的回复:]

Public Function StrToSng(ByVal Data As String) As Single
    Dim I As Integer, C As Integer, R() As Byte
    On Error GoTo hErr
    StrToSng = 0
    C = LenB(StrToSng) - 1
    ReDim R(C)
    For I = 0 To C
        R(C - I) = CByte("&H" & Mid(Data, I * 2 + 1, 2))
    Next
    CopyMemory StrToSng, R(0), LenB(StrToSng)
hErr:
End Function

谢谢！ 好像不对幺。[/quote] 调整一下字节位置顺序 For I = 0 To C R(C - I) = CByte("&H" & Mid(Data, I * 2 + 1, 2)) Next 就是这一段，比如写成 R(0) = CByte("&H" & Mid(Data, 1, 2)) R(1) = CByte("&H" & Mid(Data, 3, 2)) R(2) = CByte("&H" & Mid(Data, 5, 2)) R(3) = CByte("&H" & Mid(Data, 7, 2))

[ccbbcc]

引用 5 楼 笨狗先飞 的回复:

[quote=引用 3 楼 ccbbcc 的回复:]
[quote=引用 2 楼 笨狗先飞 的回复:]

Public Function StrToSng(ByVal Data As String) As Single
    Dim I As Integer, C As Integer, R() As Byte
    On Error GoTo hErr
    StrToSng = 0
    C = LenB(StrToSng) - 1
    ReDim R(C)
    For I = 0 To C
        R(C - I) = CByte("&H" & Mid(Data, I * 2 + 1, 2))
    Next
    CopyMemory StrToSng, R(0), LenB(StrToSng)
hErr:
End Function

谢谢！

好像不对幺。[/quote]
调整一下字节位置顺序
For I = 0 To C
R(C - I) = CByte("&H" & Mid(Data, I * 2 + 1, 2))
Next
就是这一段，比如写成
R(0) = CByte("&H" & Mid(Data, 1, 2))
R(1) = CByte("&H" & Mid(Data, 3, 2))
R(2) = CByte("&H" & Mid(Data, 5, 2))
R(3) = CByte("&H" & Mid(Data, 7, 2))[/quote]

还是不对呀

[ccbbcc]

[ccbbcc]

我楼主位的是16进制转换为10进制，那个是网上的，上下颠倒了。