stringfloat.bas

在VB程序中

Attribute VB_Name = "Module1"
'单精度4字节浮点数转换为Double
Function StringToDouble(Byte4() As Byte) As Double
Dim ldata As Double
Dim tmp As Integer

ldata = CDbl((Byte4(1) And &H7F) Or &H80) / 256 + CDbl(Byte4(2)) / 65536 + CDbl(Byte4(3)) / 16777216
tmp = CInt((Byte4(0) And &H7F)) * 2
If Byte4(1) And &H80 Then tmp = tmp + 1
tmp = tmp - 126

ldata = ldata * 2 ^ tmp
If Byte4(0) And &H80 Then ldata = -ldata

''返回结果
StringToDouble = ldata
End Function

'浮点数转换为单精度4字节
Public Sub FloatToString(xData As Double, Byte4() As Byte)
'返回一个4字节的串。
    Dim i As Integer
    Dim ldata As Double, lntData As Double
    Dim sData As Single
    Dim xLong As Long
    Dim xString As String
    Dim tmp As Integer
    Dim xPol As Boolean
    Dim xMax As Double
    
    ldata = xData
    If ldata < 0 Then
        ldata = -ldata
        xPol = True '数符为负
    End If
    
    If ldata = 0 Then   '为零处理
        For i = 0 To 3
            Byte4(i) = 0
        Next i
        Exit Sub
    End If
    
    tmp = CInt(Int(Log(ldata) / Log(2))) '求以2为底的ldata对数且四舍五入
    
    If tmp < -126 Then   '极小数返回零
        For i = 0 To 3
            Byte4(i) = 0
        Next i
        Exit Sub
    End If
    
    If tmp < 24 Then
        ldata = ldata * 2 ^ (23 - tmp)
    Else
        ldata = ldata / 2 ^ (tmp - 23)
    End If
        
    If tmp < 127 Then
        tmp = tmp + 127
    Else
        tmp = 256
    End If
    
    sData = ldata
    xLong = CLng(sData)
    xString = Hex$(xLong)
    i = Len(xString)
    If i < 6 Then
        i = 6 - i
        xString = String(i, "0") & xString
    End If
    
    Byte4(0) = CByte(tmp \ 2)
    Byte4(0) = Byte4(0) And &H7F
    If xPol = True Then Byte4(0) = Byte4(0) Or &H80     '阶码
    Byte4(1) = CByte("&H" & Mid$(xString, 1, 2))        '数码。
    Byte4(1) = Byte4(1) And &H7F
    If (tmp Mod 2) = 1 Then Byte4(1) = Byte4(1) Or &H80
    Byte4(2) = CByte("&H" & Mid$(xString, 3, 2))        '数码。
    Byte4(3) = CByte("&H" & Mid$(xString, 5, 2))        '数码。
    
End Sub