vb将单精度转换为4个字符串.docx
《vb将单精度转换为4个字符串.docx》由会员分享,可在线阅读,更多相关《vb将单精度转换为4个字符串.docx(10页珍藏版)》请在冰豆网上搜索。
vb将单精度转换为4个字符串
OptionExplicit
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(DestinationAsAny,SourceAsAny,ByValLengthAsLong)
PrivateSubcmdSinHex_Click()
Text3=""
DimiAsInteger
DimhexDataAsString
DimaAsSingle
DimBuffer(3)AsByte
a=Val(Text1)
CopyMemoryBuffer(0),a,4
Fori=0To3
IfLen(Hex(Buffer(i)))=1Then
hexData="0"&Hex(Buffer(i))+hexData
Else
hexData=Hex(Buffer(i))+hexData
EndIf
Next
Text2=hexData
Fori=1ToLen(hexData)Step2
Text3=Text3&ChrW(Val("&H"&Mid(hexData,i,2)))'&""
Next
EndSub
PrivateSubForm_Load()
Text1=""
Text2=""
Text3=""
EndSub
VB串口通信中经常会遇到10进制浮点数转为多字节Byte数据类型的情况,以及在接收后需转为10进制浮点数需求。
VB有专门的API函数CopyMemory能处理2-10进制浮点数转换和10-2进制浮点数转换。
下列代码演示了10进制Single(单精度浮点型转为16进制字符显示的浮点数和其相反运算:
OptionExplicit
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(DestinationAsAny,SourceAsAny,ByValLengthAsLong)
PrivateSubBinToSin_Click()
DimsinStrAsString
DimsinSjAsSingle
DimBuffer(3)AsByte
DimiAsInteger
sinStr=Text2
Fori=1ToLen(Text2)Step2
Buffer((7-i)/2)=Val("&H"&Mid(sinStr,i,2))
Next
CopyMemoryByValVarPtr(sinSj),ByValVarPtr(Buffer(0)),4
Text3=sinSj
EndSub
PrivateSubSinToBin_Click()
DimiAsInteger
DimhexDataAsString
DimaAsSingle
DimBuffer(3)AsByte
a=Val(Text1)
CopyMemoryBuffer(0),a,4
Fori=0To3
IfLen(Hex(Buffer(i)))=1Then
hexData="0"&Hex(Buffer(i))+hexData
Else
hexData=Hex(Buffer(i))+hexData
EndIf
Next
Text2=hexData
EndSub
下列代码演示了10进制Double(双精度浮点型)转为16进制字符显示的浮点数和其相反运算:
OptionExplicit
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(DestinationAsAny,SourceAsAny,ByValLengthAsLong)
PrivateSubcmdDoubHex_Click()
DimiAsInteger
DimhexDataAsString
DimaAsDouble
DimBuffer(7)AsByte
a=Val(Text1)
CopyMemoryBuffer(0),a,8
Fori=0To7
IfLen(Hex(Buffer(i)))=1Then
hexData="0"&Hex(Buffer(i))+hexData
Else
hexData=Hex(Buffer(i))+hexData
EndIf
Next
Text2=hexData
EndSub
PrivateSubcmdHexDec_Click()
DimsinStrAsString
DimsinSjAsDouble
Dimbytes(7)AsByte
DimiAsInteger
sinStr=Text2
Fori=1ToLen(Text2)Step2
bytes((15-i)/2)=Val("&H"&Mid(sinStr,i,2))
Next
CopyMemoryByValVarPtr(sinSj),ByValVarPtr(bytes(0)),8
Text3=sinSj
EndSub
但从中无法了解它是如何进行运算处理的。
以下通过对Single(单精度浮点型)和Double(双精度浮点型)在内存的储存方式进行分析。
VB的Single数据类型
Single(单精度浮点型)变量存储为IEEE32位(4个字节)浮点数值的形式,它的范围在负数的时候是从-3.402823E38到-1.401298E-45,而在正数的时候是从1.401298E-45到3.402823E38。
Single的类型声明字符为感叹号(!
)。
在内存以32位二进制形式存在:
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
第1位为符号位
第2-9位为阶码位
第10-32位为2进制小数尾值
即F2^n*1.XXXXXXXXXXXXXXXXXXXXXXX
其中
F为正号或负号(首为为0正数,首位为1负数
n为2-9位组成的BYTE数据值
XXXXXXXXXXXXXXXXXXXXXXX为尾数
Double(双精度浮点型)变量存储为IEEE64位(8个字节)浮点数值的形式,它的范围在负数的时候是从-1.79769313486232E308到-4.94065645841247E-324,而正数的时候是从4.94065645841247E-324到1.79769313486232E308。
Double的类型声明字符是数字符号(#)。
在内存以64位二进制形式存在:
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
第1位为符号位
第2-12位为阶码位
第13-64位为2进制小数尾值
即F2^n*1.XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
其中
F为正号或负号(首为为0正数,首位为1负数
n为2-12位组成的BYTE数据值
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX为尾数
以下代码是基于前叙述的Single(单精度浮点型)在内存的储存方式进行分析后作出的2-10进制浮点数运算:
OptionExplicit
DimhexDataAsString
DimiAsSingle
DimbindataAsString
DimzsAsString*8
DimzsszAsString
DimxsAsString*23
Dimxs_js()AsDouble
Dimxs_hjAsDouble
DimsinDataAsSingle
DimsHexAsString
DimsBinAsString
DimfhAsString
PrivateSubCommand1_Click()
DimfhAsString
sHex=Text1
HexToBin(sHex)
fh=Mid(bindata,1,1)'取符号
zs=Mid(bindata,2,8)'取指数阶码
xs=Mid(bindata,10,23)'取2进制小数
xs_hj=0
zssz=BinToHex(zs)
ReDimxs_js(1To23)
Fori=1To23
xs_js(i)=Val(Mid(xs,i,1))
xs_hj=xs_hj+xs_js(i)/(2^(i))
Next
Ifzs<>"00000000"Then
Shape1.FillColor=vbGreen
Iffh=0Then
sinData=2^(Val("&H"&zssz)-127)*(1+xs_hj)
ElseIffh=1Then
sinData=-2^(Val("&H"&zssz)-127)*(1+xs_hj)
EndIf
ElseIfsHex="00000000"Then
sinData=0
Shape1.FillColor=vbGreen
ElseIfzs="00000000"Then'处理在0到1.175494351E-38及
Shape1.FillColor=vbRed'0到-1.175494351E-38间的浮点数
Iffh=0Then
sinData=2^(Val("&H"&zssz)-126)*xs_hj
ElseIffh=1Then
sinData=-2^(Val("&H"&zssz)-126)*xs_hj
EndIf
EndIf
Text2=sinData
EndSub
PublicFunctionHexToBin(ByValsHexAsString)AsString
Consts1="0",s2="0125A4936DB7FEC8"
DimiAsInteger,sBinAsString
sHex=UCase(sHex)
Fori=1ToLen(sHex)
sBin=sBin&Mid(s1,InStr(1,s2,Mid(sHex,i,1)),4)
Nexti
HexToBin=sBin
bindata=sBin
EndFunction
PublicFunctionBinToHex(ByValsBinAsString)AsString
Consts1="0",s2="0125A4936DB7FEC8"
DimiAsInteger,sHexAsString
sBin=String(3-(Len(sBin)-1)Mod4,"0")&sBin
Fori=1ToLen(sBin)Step4
sHex=sHex&Mid(s2,InStr(1,s1,Mid(sBin,i,4)),1)
Nexti
BinToHex=sHex
EndFunction
以下代码是基于前叙述的Double(双精度浮点型)在内存的储存方式进行分析后作出的2-10进制浮点数运算:
OptionExplicit
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(DestinationAsAny,SourceAsAny,ByValLengthAsLong)
DimhexDataAsString
DimiAsSingle
DimbindataAsString
DimzsAsString'*8
DimzsszAsString
DimxsAsString'*23
Dimxs_js()AsDouble
Dimxs_hjAsDouble
DimsinDataAsDouble
DimsHexAsString
DimsBinAsString
PrivateSubCommand2_Click()
DimfhAsString
sHex=Text2
HexToBin(sHex)
fh=Mid(bindata,1,1)
zs=Mid(bindata,2,11)'取指数
xs=Mid(bindata,13,52)'取2进制小数
xs_hj=0
zs="0"&zs
zssz=BinToHex(zs)
ReDimxs_js(1To52)
Fori=1To52
xs_js(i)=Val(Mid(xs,i,1))
xs_hj=xs_hj+xs_js(i)/(2^(i))
Next
Ifzs<>"000000000000"Then
Shape1.FillColor=vbGreen
Iffh=0Then
sinData=2^(Val("&H"&zssz)-1023)*(1+xs_hj)
ElseIffh=1Then
sinData=-2^(Val("&H"&zssz)-1023)*(1+xs_hj)
EndIf
ElseIfsHex="00000000"Then
sinData=0
Shape1.FillColor=vbGreen
ElseIfzs="000000000000"Then'处理在0到2.2250738585072E-308及
Shape1.FillColor=vbRed'0到-2.2250738585072E-308间的浮点数Iffh=0Then
sinData=2^(Val("&H"&zssz)-1022)*xs_hj
ElseIffh=1Then
sinData=-2^(Val("&H"&zssz)-1022)*xs_hj
EndIf
EndIf
Text3=sinData
EndSub
PublicFunctionHexToBin(ByValsHexAsString)AsString
Consts1="0",s2="0125A4936DB7FEC8"
DimiAsInteger,sBinAsString
sHex=UCase(sHex)
Fori=1ToLen(sHex)
sBin=sBin&Mid(s1,InStr(1,s2,Mid(sHex,i,1)),4)
Nexti
HexToBin=sBin
bindata=sBin
EndFunction
PublicFunctionBinToHex(ByValsBinAsString)AsString
Consts1="0",s2="0125A4936DB7FEC8"
DimiAsInteger,sHexAsString
sBin=String(3-(Len(sBin)-1)Mod4,"0")&sBin
Fori=1ToLen(sBin)Step4
sHex=sHex&Mid(s2,InStr(1,s1,Mid(sBin,i,4)),1)
Nexti
BinToHex=sHex
EndFunction
字符串类型转化为单精度类型
PrivateSubCommand1_Click()
s="123.456"
d=CSng(s)
Printd
EndSub
本来浮点数是这样转化的,但是好象显示的结果和你的有点不同,我不知道什么原因
VBcode
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(DestinationAsAny,SourceAsAny,ByValLengthAsLong)
PublicFunctionSngToLng(ByValValueAsSingle)AsLong
CopyMemorySngToLng,Value,4
EndFunction
PublicFunctionLngToSng(ByValValueAsLong)AsSingle
CopyMemoryLngToSng,Value,4
EndFunction