vb编写浮点数转换程序-熟悉copymemery的最好

Question

以二进制读取数据文件，数据格式为32-bit floating point，存储到单精度变量www中，在VB中怎么样用copymemery将数据转换过来？QB源程序如下： 
GET #1,513,www! '从513开始，全部为32-bit floating point. 
wave(0)=singlecf(www!) FUNCTION singlecf!(d!) 
al$=MID$(MKS$(d!),4,1) 
al$=MID$(MKS$(d!),3,1) 
al$=MID$(MKS$(d!),2,1) 
al$=MID$(MKS$(d!),1,1) 
singlecf!=CVS(a1$+a2$+a3$+a4$) 
END FUNCTION

Answer 1

你的题目解决较复杂：
Option Explicit
    Dim hexData As String
    Dim i As Single
    Dim j As Integer
    Dim k As Integer
    Dim bl As String
    Dim bl_dm As String
    Dim BinData As String
    Dim ccl() As String
    Dim Ccll() As String
    Dim fh As String * 1
    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 bb_h(1) As String
    Dim bb_hh(1) As String
    Dim bll_0 As String
    Dim sinData As Single
    Dim a As Byte
    Dim aa As String
    Dim bb As String
    Dim nw As Long
    Dim nw1 As Long
    Dim qx() As Single
    Dim jlcd As Integer
    
Private Sub cmdBinSin_Click()
    Cod  '将4字节BYTE数据转为Single浮点数
End SubPrivate Sub cmdOpen_Click()
    CommonDialog1.ShowOpen
    Open CommonDialog1.FileName For Binary As #1
        jlcd = LOF(1) '判断文件总字节数
    Close
    Text2 = jlcd
    ReDim qx((jlcd - 512) \ 4 - 1) '获取Single浮点数的个数
    Timer1.Enabled = True '启动循环读取
End SubPrivate Sub cmdOpenBin_Click()
    bb = ""
    Open CommonDialog1.FileName For Binary As #1
    For i = 513 + nw1 To 516 + nw1 '每次读4字节
        nw = Seek(1)
        nw1 = nw - 512
        Get #1, i, a
        aa = Right$(Hex(a), 2)
        If Len(aa) = 1 Then
            aa = "0" & aa
        End If
        bb = bb & aa '& " "
        Text1 = nw '读取字节号
        If i >= (jlcd - 512) \ 4 Then
            Timer1.Enabled = False
            Exit For
        End If
    Next
    Close #1
    cmdBinSin_Click
    qx(k) = sinData
    k = k + 1
End SubPrivate Sub Form_Load()
    Text1 = ""
    Text2 = ""
    Timer1.Enabled = False
    Timer1.Interval = 1
End SubPrivate Sub Cod()
    BinData = ""
    bl = bb
    If Len(bl) = 8 Then
         '16-2转换
        ReDim ccl(1 To Len(bl))
        ReDim Ccll(1 To Len(bl))
        For i = 1 To Len(bl)
            ccl(i) = Mid(bl, i, 1)
        Next i
        For j = 1 To Len(bl)
        bl = ccl(j)
            If bl = "F" Then
                bl_dm = "1111"
            ElseIf bl = "E" Then
                bl_dm = "1110"
            ElseIf bl = "D" Then
                bl_dm = "1101"
            ElseIf bl = "C" Then
                bl_dm = "1100"
            ElseIf bl = "B" Then
                bl_dm = "1011"
            ElseIf bl = "A" Then
                bl_dm = "1010"
            ElseIf bl = "9" Then
                bl_dm = "1001"
            ElseIf bl = "8" Then
                bl_dm = "1000"
            ElseIf bl = "7" Then
                bl_dm = "0111"
            ElseIf bl = "6" Then
                bl_dm = "0110"
            ElseIf bl = "5" Then
                bl_dm = "0101"
            ElseIf bl = "4" Then
                bl_dm = "0100"
            ElseIf bl = "3" Then
                bl_dm = "0011"
            ElseIf bl = "2" Then
                bl_dm = "0010"
            ElseIf bl = "1" Then
                bl_dm = "0001"
            ElseIf bl = "0" Then
                bl_dm = "0000"
            Else:
                bl_dm = ""
            End If
            Ccll(j) = bl_dm
            BinData = BinData & Ccll(j)
        Next j
        fh = Mid(BinData, 1, 1) '取符号
        zs = Mid(BinData, 2, 8) '取指数
        xs = Mid(BinData, 10, 23) '取2进制小数
        xs_hj = 0
        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
        '返回10进制浮点小数部分
        '2-16转换
        bb_h(0) = Mid(zs, 1, 4)
        bb_h(1) = Mid(zs, 5, 4)
        For i = 0 To 1
            If bb_h(i) = "1111" Then
                bb_hh(i) = "F"
            ElseIf bb_h(i) = "1110" Then
                bb_hh(i) = "E"
            ElseIf bb_h(i) = "1101" Then
                bb_hh(i) = "D"
            ElseIf bb_h(i) = "1100" Then
                bb_hh(i) = "C"
            ElseIf bb_h(i) = "1011" Then
                bb_hh(i) = "B"
            ElseIf bb_h(i) = "1010" Then
                bb_hh(i) = "A"
            ElseIf bb_h(i) = "1001" Then
                bb_hh(i) = "9"
            ElseIf bb_h(i) = "1000" Then
                bb_hh(i) = "8"
            ElseIf bb_h(i) = "0111" Then
                bb_hh(i) = "7"
            ElseIf bb_h(i) = "0110" Then
                bb_hh(i) = "6"
            ElseIf bb_h(i) = "0101" Then
                bb_hh(i) = "5"
            ElseIf bb_h(i) = "0100" Then
                bb_hh(i) = "4"
            ElseIf bb_h(i) = "0011" Then
                bb_hh(i) = "3"
            ElseIf bb_h(i) = "0010" Then
                bb_hh(i) = "2"
            ElseIf bb_h(i) = "0001" Then
                bb_hh(i) = "1"
            ElseIf bb_h(i) = "0000" Then
                bb_hh(i) = "0"
            End If
        Next i
        zssz = bb_hh(0) & bb_hh(1)
        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 bl = "00000000" Then
            sinData = 0
        ElseIf zs = "00000000" Then  '处理在0到1.175494351E-38及
             '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
    End If
End Sub
Private Sub Timer1_Timer()
     cmdOpenBin_Click
End Sub

Answer 2

以随机方式读写Single熟代码：
Option Explicit
    Dim www As Single
    Dim FileLength
    Dim recordnum As IntegerPrivate Sub Command1_Click() '追加记录
    www = InputBox("输入www", www)
    Open "c:\s.dat" For Random As #1 Len = 4
        recordnum = LOF(1) \ Len(www)
        recordnum = recordnum + 1
        Put #1, recordnum, www
    Close #1
        Text5 = recordnum
End SubPrivate Sub Command2_Click() ' 读记录
    recordnum = InputBox("查询记录号", recordnum)
    Open "c:\s.dat" For Random As #1 Len = 4
        Get #1, recordnum, www
    Close #1
    Text5 = www
End SubPrivate Sub Command3_Click() ' 获取记录数
    Open "c:\s.dat" For Random As #1 Len = 4
        recordnum = LOF(1) \ Len(www)
        Text5 = recordnum
    Close #1
End Sub

Answer 3

Option Explicit
    Dim www As Single
    Dim FileLength
    Dim recordnum As Integer
    Dim recordnum1 As Integer
    Dim qx() As Single
    Dim jlcd As IntegerPrivate Sub readSin() ' 读记录
    Open CommonDialog1.FileName For Random As #1 Len = 4
        Get #1, recordnum, www
    Close #1
    qx(recordnum - 129) = www
    Text2 = qx(recordnum - 129)
    Text1 = recordnum - 129
    recordnum = recordnum + 1
    If recordnum >= recordnum1 + 1 Then
        Timer1.Enabled = False
    End If
End SubPrivate Sub Command1_Click() ' 获取记录数
    CommonDialog1.ShowOpen
    Open CommonDialog1.FileName For Random As #1 Len = 4
        recordnum1 = LOF(1) \ Len(www)
        Text3 = recordnum1
    Close #1
    ReDim qx(recordnum1 - 129)
    Timer1.Enabled = True
End SubPrivate Sub Form_Load()
    recordnum = 129
    Timer1.Enabled = False
    Timer1.Interval = 1
End Sub