form1.frm

二进制浮点数的转换

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "浮点数转为字符工具"
   ClientHeight    =   4230
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6045
   LinkTopic       =   "Form1"
   ScaleHeight     =   4230
   ScaleWidth      =   6045
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "转换为浮点数"
      Height          =   495
      Left            =   4320
      TabIndex        =   5
      Top             =   1440
      Width           =   1215
   End
   Begin VB.TextBox T2 
      Height          =   375
      Left            =   1800
      TabIndex        =   4
      Top             =   1440
      Width           =   2295
   End
   Begin VB.CommandButton Command1 
      Caption         =   "转换为字符串"
      Height          =   495
      Left            =   4320
      TabIndex        =   2
      Top             =   360
      Width           =   1215
   End
   Begin VB.TextBox T1 
      Height          =   375
      Left            =   1800
      TabIndex        =   0
      Top             =   480
      Width           =   2295
   End
   Begin VB.Label Label2 
      Caption         =   "转换后的字符串"
      Height          =   495
      Left            =   240
      TabIndex        =   3
      Top             =   1560
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "单精度浮点数"
      Height          =   255
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'copyright by mj @2007.11.6
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Function floattostring(ByVal word As Single) As String

    Dim bytRet1 As Byte
    Dim bytRet2 As Byte
    Dim bytRet3 As Byte
    Dim bytRet4 As Byte
    
    Dim str1 As String
    Dim str2 As String
    Dim str3 As String
    Dim str4 As String

    CopyMemory bytRet1, ByVal VarPtr(word), 1
    CopyMemory bytRet2, ByVal VarPtr(word) + 1, 1
    CopyMemory bytRet3, ByVal VarPtr(word) + 2, 1
    CopyMemory bytRet4, ByVal VarPtr(word) + 3, 1

    str1 = Format(CStr(Hex(bytRet1)), "00")
    str2 = Format(CStr(Hex(bytRet2)), "00")
    str3 = Format(CStr(Hex(bytRet3)), "00")
    str4 = Format(CStr(Hex(bytRet4)), "00")

    
    
      floattostring = str1 + str2 + str3 + str4
End Function

Function stringtofloat(ByVal word As String) As Single
    
    Dim nBytes(0 To 3) As Byte
    Dim fSingle As Single, i As Long
    Dim b As Long
    Dim c As Long
    
    b = 1
    
    For i = 0 To 3
        nBytes(i) = "&H" + CStr(Mid(word, b, 2))
        b = b + 2
    Next i
    
    CopyMemory fSingle, nBytes(0), 4
    stringtofloat = Format(fSingle, ".###")

End Function

Private Sub Command1_Click()

    T2.Text = floattostring(CSng(T1.Text))

End Sub

Private Sub Command2_Click()

    T1.Text = CStr(stringtofloat(T2.Text))
    
End Sub