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
升级会员 