以下代码为原创，实践验证过
Public Function r_data(add As Byte, ty As String, firsth As Byte, firstl As Byte, total As Byte) As String '读MODBUS数据
On Error GoTo a:
ReDim CRC(1) As Byte
Dim FGetData As String
ReDim a(5) As Byte
Dim m As Integer
Dim x As Integer
Dim aa1 As Byte
Dim e As Byte
x = Me.comm_RS_time
Select Case ty '判断寄存器类型
Case "AI" '读输入寄存器数值
a(1) = "&h" & Hex(4)
Case "DI" '读输入线圈状态
a(1) = "&h" & Hex(2)
Case "HR" '读保持寄存器数据
a(1) = "&h" & Hex(3)
Case "C" '读输出线圈状态
a(1) = "&h" & Hex(1)
End Select
a(0) = "&h" & Hex(add)
a(2) = "&h" & Hex(firsth)
a(3) = "&h" & Hex(firstl)
a(4) = "&h" & Hex(0)
a(5) = "&h" & Hex(total)
CRC = CRC16(a) '调用CRC16计算函数
'CRC(0)为高位
'CRC(1)为低位
ReDim Preserve a(0 To 7) As Byte
a(6) = "&h" & Hex(CRC(1))
a(7) = "&h" & Hex(CRC(0))
MSComm1.Output = a
Do
DoEvents
Loop Until MSComm1.OutBufferCount = 0 '等待，直到数据发送完毕
Sleep (x)
Select Case ty
Case "AI"
m = total * 2 + 5
Case "DI"
m = total \ 8
aa1 = total Mod 8
If aa1 > 0 Then
m = m + 1
End If
m = m + 5 '计算串口应该返回的字节数
Case "HR"
m = total * 2 + 5
Case "C"
m = total \ 8
aa1 = total Mod 8
If aa1 > 0 Then
m = m + 1
End If
m = m + 5 '计算串口应该返回的字节数
End Select
FGetData = ReceiveData(m)
If Len(FGetData) <> m * 2 Then '接收的字节数不对
Me.comm_fault = True '通信失败标志位置位
r_data = ""
Exit Function
Else 'CRC校验
ReDim y(0 To m - 3) As Byte
Dim i As Integer
For i = 0 To m - 3
y(i) = "&h" & Hex(Hex_Dec(Mid(FGetData, (i + 1) * 2 - 1, 2)))
Next
CRC = CRC16(y) '调用CRC16计算函数
ReDim Preserve y(0 To m - 1) As Byte
y(m - 2) = "&h" & Hex(CRC(1))
y(m - 1) = "&h" & Hex(CRC(0))
If y(m - 2) <> "&h" & Hex(Hex_Dec(Mid(FGetData, (m - 1) * 2 - 1, 2))) Or y(m - 1) <> "&h" & Hex(Hex_Dec(Mid(FGetData, m * 2 - 1, 2))) Then
r_data = ""
GoTo mm1 'CRC校验失败
End If
End If
e = Hex_Dec(Mid(FGetData, 5, 2))
r_data =ｍｉｄ（FGetData, 7, e * 2) '返回接收的数据
Erase CRC, a, y
mm1:
Erase CRC, a, y
Exit Function
a:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Function
暮色大侠，粗看一下，你的程式没有整数转浮点数的程序。没有波特率选择，没有校验选择，没有停止位。
也许俺笨，你能不能做这样的程式：画面做一个显示框用来显示40001的浮点数，一个输入框用来控制40003的浮点数，一个指示灯用来显示00001的位，一个开关用来控制00003的位。发VB原程式到我邮箱好吗？SJBO_2003@163.com
Modbus通信协议&VB测试程序
协议内容:http://download.gongkong.com/file/2005/6/13/Modbus.pdf
VB测试程序：
Option Explicit
Private Text1text As String
Private RTUCRC As String
'串口选择
Private Sub Combo1_Click()
MSComm1.CommPort = Combo1.ListIndex + 1
End Sub
'数据位改变
Private Sub Combo2_Click()
Call setting
End Sub
'波特率改变
Private Sub Combo3_Click()
Call setting
End Sub
'奇偶校验改变
Private Sub Combo4_Click()
Call setting
End Sub
'停止位改变
Private Sub Combo5_Click()
Call setting
End Sub
Private Sub setting()
MSComm1.Settings = CStr(Combo3.Text) & "," & CStr(Combo4.Text) & "," & CStr(Combo2.Text) _
& "," & CStr(Combo5.Text)
End Sub
'打开关闭串口
Private Sub Command1_Click()
On Error Resume Next
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
End If
If MSComm1.PortOpen Then '打开关闭按钮显示文字及combo1使能
Command1.Caption = "关闭串口"
Combo1.Enabled = False
Else
Command1.Caption = "打开串口"
Combo1.Enabled = True
End If
If Err Then '打开串口失败，则显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
End Sub
'10转16进制
Private Sub Command2_Click(Index As Integer)
On Error Resume Next
Text4.Text = Hex(Text3.Text)
If Err Then ''则显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
End Sub
'16转10进制
Private Sub Command3_Click()
Dim a As Long
a = Val("&H" & CStr(Text4.Text))
Text3.Text = a
End Sub
'手动串口发送
Private Sub Command4_Click()
If MSComm1.PortOpen = False Then
MsgBox "请先打开串口", , "错误信息"
Exit Sub
End If
Call sentsub
End Sub
'清除接收窗
Private Sub Command5_Click()
Text2.Text = ""
End Sub
Private Sub Command6_Click()
Unload Me
End Sub
Private Sub Command7_Click()
On Error Resume Next
Dim STP As String
STP = CStr(Chr(2)) & "010001" & CStr(Chr(3)) & "25"
MSComm1.Settings = "9600,N,7,2"
MSComm1.PortOpen = True
MSComm1.Output = STP
MSComm1.PortOpen = False
If Err Then '打开串口失败，则显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
End Sub
Private Sub Command8_Click()
On Error Resume Next
Dim FWD As String
FWD = CStr(Chr(2)) & "010101" & CStr(Chr(3)) & "26"
MSComm1.Settings = "9600,N,7,2"
MSComm1.PortOpen = True
MSComm1.Output = FWD
MSComm1.PortOpen = False
If Err Then '打开串口失败，则显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
End Sub
Private Sub Command9_Click()
On Error Resume Next
Dim REV As String
REV = CStr(Chr(2)) & "010201" & CStr(Chr(3)) & "27"
MSComm1.Settings = "9600,N,7,2"
MSComm1.PortOpen = True
MSComm1.Output = REV
MSComm1.PortOpen = False
If Err Then '打开串口失败，则显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
End Sub
'窗口加载
Private Sub Form_Load()
Dim d%
For d = 1 To 16
Combo1.AddItem ("COM" & CStr(d))
Next
Combo1.ListIndex = 0
Combo2.AddItem "6"
Combo2.AddItem "7"
Combo2.AddItem "8"
Combo2.ListIndex = 2
Combo3.AddItem "110"
Combo3.AddItem "330"
Combo3.AddItem "1200"
Combo3.AddItem "2400"
Combo3.AddItem "4800"
Combo3.AddItem "9600"
Combo3.AddItem "19200"
Combo3.AddItem "38400"
Combo3.AddItem "56000"
Combo3.AddItem "57600"
Combo3.AddItem "115200"
Combo3.ListIndex = 5
Combo4.AddItem "n"
Combo4.AddItem "o"
Combo4.AddItem "e"
Combo4.ListIndex = 0
Combo5.AddItem "1"
Combo5.AddItem "2"
Combo5.ListIndex = 0
For d = 0 To 254
Combo6.AddItem d
Next
Combo6.ListIndex = 1
Text1.Text = "010601001770"
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = "1000"
Text6.Text = "06"
Text7.Text = "0"
Text8.Text = "1"
Option1.value = True
Option3.value = True
Option7.value = True
Option9.value = True
If MSComm1.PortOpen = False Then
Command1.Caption = "打开串口"
Else
Command1.Caption = "关闭串口"
End If
End Sub
'串口接收程序
Private Sub MSComm1_OnComm()
Dim Hexｃｈｒ As String, hexstring As String, i As Integer, j As Integer, hexdisp As String
If Option8.value Then
hexstring = MSComm1.Input '十六进制显示
i = Len(hexstring)
For j = 1 To i
Hexｃｈｒ =ｍｉｄ（hexstring, j, 1)
If Hex(Asc(Hexchr)) < 16 Then
Text2.Text = Text2.Text & "0" & Hex(Asc(Hexchr)) & " "
Else
Text2.Text = Text2.Text & Hex(Asc(Hexchr)) & " "
End If
Next j
Text2.Text = Text2.Text & CStr(Chr(13)) & CStr(Chr(10))
Else
Text2.Text = Text2.Text & MSComm1.Input & CStr(Chr(13)) & CStr(Chr(10)) 'ASCII码显示
End If
End Sub
'手动发送选择
Private Sub Option1_Click()
If Option1.value = True Then
Timer1.Enabled = False
Command4.Enabled = True
Else
Timer1.Enabled = True
Command4.Enabled = False
End If
End Sub
'Delta ASCII发送协议
Private Sub Option10_Click()
Combo6.Enabled = True
Text6.Enabled = True
Text7.Enabled = True
Text8.Enabled = True
Label10.Enabled = True
Label11.Enabled = True
Label12.Enabled = True
Label13.Enabled = True
Option6.Enabled = False
Option7.Enabled = False
Option11.value = True
Combo2.ListIndex = 1
Combo5.ListIndex = 1
Text1.Enabled = False
Label14.Enabled = False
Frame7.Visible = True
End Sub
'自动发送选择
Private Sub Option2_Click()
If Option2.value = True Then
Timer1.Enabled = True
Command4.Enabled = False
Else
Timer1.Enabled = False
Command4.Enabled = True
End If
End Sub
Private Sub Option3_Click() 'Non选项
Combo6.Enabled = False
Text6.Enabled = False
Text7.Enabled = False
Text8.Enabled = False
Label10.Enabled = False
Label11.Enabled = False
Label12.Enabled = False
Label13.Enabled = False
Option6.Enabled = True
Option7.Enabled = True
Combo2.ListIndex = 2
Combo5.ListIndex = 0
Text1.Enabled = True
Label14.Enabled = True
Frame7.Visible = False
End Sub
Private Sub Option4_Click() 'ASCII选项
Combo6.Enabled = True
Text6.Enabled = True
Text7.Enabled = True
Text8.Enabled = True
Label10.Enabled = True
Label11.Enabled = True
Label12.Enabled = True
Label13.Enabled = True
Option6.Enabled = False
Option7.Enabled = False
Combo2.ListIndex = 1
Combo5.ListIndex = 1
Text1.Enabled = False
Label14.Enabled = False
Frame7.Visible = False
End Sub
Private Sub Option5_Click() 'RTU选项
Combo6.Enabled = True
Text6.Enabled = True
Text7.Enabled = True
Text8.Enabled = True
Label10.Enabled = True
Label11.Enabled = True
Label12.Enabled = True
Label13.Enabled = True
Option6.Enabled = False
Option7.Enabled = False
Combo2.ListIndex = 2
Combo5.ListIndex = 1
Text1.Enabled = False
Label14.Enabled = False
Frame7.Visible = False
End Sub
'发送时间间隔调整输入
Private Sub Text5_Change()
Dim number As String
Dim num As Integer
Dim numcyc As Integer
num = Len(Text5.Text)
For numcyc = 1 To num
number =ｍｉｄ（Text5.Text, numcyc, 1)
Select Case InStr("0123456789", number)
Case 0
MsgBox "输入时间间隔错误，请重新输入", , "错误信息"
Exit Sub
End Select
Next
Timer1.Interval = Text5.Text
End Sub
'自动发送定时器
Private Sub Timer1_Timer()
If MSComm1.PortOpen Then
Call sentsub
End If
End Sub
'状态刷新定时器
Private Sub Timer2_Timer()
StatusBar1.Panels(1).Text = "串口选择：" & CStr(Combo1.Text)
StatusBar1.Panels(2).Text = "串口设置：" & CStr(MSComm1.Settings)
StatusBar1.Panels(3).Text = "串口状态：" & CStr(MSComm1.PortOpen)
End Sub
'串口发送子程序
Private Sub sentsub()
Dim optioncase%
If Option3.value Then optioncase = 1
If Option4.value Then optioncase = 2
If Option5.value Then optioncase = 3
If Option10.value Then optioncase = 4
Select Case optioncase
Case 1
If Option6.value Then
Text1text = Text1.Text
Call Hexsent
Else
Text1text = Text1.Text
Call ASCIIsent
End If
Case 2
Call incorporate '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Call ASCIIcheck
Call ASCIIsent
Case 3
Call incorporate '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Call RTUcheck
Call Hexsent
Case 4
Call incorporate1 '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Call deltaASCII
Call ASCIIsent
End Select
End Sub
'十六进制发送
Private Sub Hexsent()
Dim hexchrlen%, Hexｃｈｒ As String, hexcyc%, hexｍｉｄAs Byte, hexmiddle As String
Dim hexchrgroup() As Byte, i As Integer
hexchrlen = Len(Text1text)
For hexcyc = 1 To hexchrlen '检查Text1文本框内数值是否合适
Hexｃｈｒ =ｍｉｄ（Text1text, hexcyc, 1)
If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
MsgBox "无效的数值，请重新输入", , "错误信息"
Exit Sub
End If
Next
ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
For hexcyc = 1 To hexchrlen Step 2 '将文本框内数值分成两个、两个
i = i + 1
Hexｃｈｒ =ｍｉｄ（Text1text, hexcyc, 2)
hexｍｉｄ= Val("&H" & CStr(Hexchr))
hexchrgroup(i) = hexmid
'MSComm1.Output = CStr(hexmid)
Next
MSComm1.Output = hexchrgroup
End Sub
'ASC码发送
Private Sub ASCIIsent()
MSComm1.Output = Text1text
End Sub
'ASC校验,此段程序计算出LRC校验值，并加上字头和字尾
Private Sub ASCIIcheck()
Dim a%, b%, chrnum%, Lrcbyte As String
Dim checksum%, char%, AscLrc%, Lrc%
chrnum = Len(Text1text)
For a = 1 To chrnum Step 2
ｃｈａｒ = Val("&H" & CStr(Mid(Text1text, a, 2))) '两个两个的取字符
checksum = checksum + char '全部加起来
Next
AscLrc = checksum Mod &H100 '取255的余数
Lrc = (&HFF - AscLrc) + 1 '取二次补
If Lrc < 16 Then '此段程序是判断Hex(lrc)是否是一位数，
Lrcbyte = "0" + CStr(Hex(Lrc)) '如果是的话，前面加0；否则不加零
Else
Lrcbyte = CStr(Hex(Lrc))
End If
Text1text = CStr(Chr(58)) & CStr(Text1text) & Lrcbyte & CStr(Chr(13)) & CStr(Chr(10))
End Sub
'DeltaASCII校验,此段程序计算出LRC校验值，并加上字头和字尾
Private Sub deltaASCII()
Dim a%, b%, chrnum%, Lrcbyte As String
Dim checksum%, char%, Lrc%
chrnum = Len(Text1text)
For a = 1 To chrnum
ｃｈａｒ = Asc(Mid(Text1text, a, 1)) '两个两个的取字符
checksum = checksum + char '全部加起来
Next
Lrc = (checksum + &H3) Mod &H100 '取255的余数
If Lrc < 16 Then '此段程序是判断Hex(lrc)是否是一位数，
Lrcbyte = "0" + CStr(Hex(Lrc)) '如果是的话，前面加0；否则不加零
Else
Lrcbyte = CStr(Hex(Lrc))
End If
Text1text = CStr(Chr(2)) & CStr(Text1text) & CStr(Chr(3)) & Lrcbyte
End Sub
'RTU校验
Private Sub RTUcheck()
Dim CRC() As Byte
Dim d(5) As Byte
Dim string1 As String
Dim j As Integer, chrlength As Integer, temp As String
string1 = Text1text
chrlength = Len(string1)
For j = 0 To chrlength / 2 - 1
temp =ｍｉｄ（string1, j * 2 + 1, 2)
d(j) = Val("&H" & temp)
Next
RTUCRC = CRC16(d) '调用CRC16计算函数, CRC(0)为高位, CRC(1)为低位
Text1text = Text1text & RTUCRC
End Sub
Private Sub incorporate() '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Dim wholeｃｈａｒ As String, wc%, wcyc%, wｃｈａｒ As String
Dim SID As String, Cmd As String, InfoAdd As String, data As String
Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
On Error Resume Next
wholeｃｈａｒ = CStr(Combo6.Text) & CStr(Text6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
wc = Len(wholechar)
For wcyc = 1 To wc
wｃｈａｒ =ｍｉｄ（wholechar, wcyc, 1)
If InStr("0123456789", wchar) = 0 Then
MsgBox "输入错误，请重新输入", , "错误提示"
Exit Sub
End If
Next
SIDnum = Len(CStr(Hex(Combo6.Text)))
Select Case SIDnum
Case 0
Exit Sub
Case 1
SID = "0" & CStr(Hex(Combo6.Text))
Case 2
SID = CStr(Hex(Combo6.Text))
End Select
Cmdnum = Len(CStr(Hex(Text6.Text)))
Select Case Cmdnum
Case 0
Exit Sub
Case 1
Cmd = "0" & CStr(Hex(Text6.Text))
Case 1
Cmd = CStr(Hex(Text6.Text))
End Select
InfoAddNum = Len(CStr(Hex(Text7.Text)))
Select Case InfoAddNum
Case 0
Exit Sub
Case 1
InfoAdd = "000" & CStr(Hex(Text7.Text))
Case 2
InfoAdd = "00" & CStr(Hex(Text7.Text))
Case 3
InfoAdd = "0" & CStr(Hex(Text7.Text))
Case 4
InfoAdd = CStr(Hex(Text7.Text))
End Select
Datanum = Len(CStr(Hex(Text8.Text)))
Select Case Datanum
Case 0
Exit Sub
Case 1
data = "000" & CStr(Hex(Text8.Text))
Case 2
data = "00" & CStr(Hex(Text8.Text))
Case 3
data = "0" & CStr(Hex(Text8.Text))
Case 4
data = CStr(Hex(Text8.Text))
End Select
If Err Then '显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
End Sub
Private Sub incorporate1() '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Dim wholeｃｈａｒ As String, wc%, wcyc%, wｃｈａｒ As String
Dim SID As String, Cmd As String, InfoAdd As String, data As String
Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
On Error Resume Next
wholeｃｈａｒ = CStr(Combo6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
wc = Len(wholechar)
For wcyc = 1 To wc
wｃｈａｒ =ｍｉｄ（wholechar, wcyc, 1)
If InStr("0123456789", wchar) = 0 Then
MsgBox "输入错误，请重新输入", , "错误提示"
Exit Sub
End If
Next
SIDnum = Len(CStr(Hex(Combo6.Text)))
Select Case SIDnum
Case 0
Exit Sub
Case 1
SID = "0" & CStr(Hex(Combo6.Text))
Case 2
SID = CStr(Hex(Combo6.Text))
End Select
'Cmdnum = Len(CStr(Hex(Text6.Text)))
'Select Case Cmdnum
'Case 0
' Exit Sub
'Case 1
' Cmd = "0" & CStr(Hex(Text6.Text))
'Case 1
' Cmd = CStr(Hex(Text6.Text))
'End Select
InfoAddNum = Len(CStr(Hex(Text7.Text)))
Select Case InfoAddNum
Case 0
Exit Sub
Case 1
InfoAdd = "0" & CStr(Hex(Text7.Text))
Case 2
InfoAdd = CStr(Hex(Text7.Text))
End Select
Datanum = Len(CStr(Hex(Text8.Text)))
Select Case Datanum
Case 0
Exit Sub
Case 1
data = "000" & CStr(Hex(Text8.Text))
Case 2
data = "00" & CStr(Hex(Text8.Text))
Case 3
data = "0" & CStr(Hex(Text8.Text))
Case 4
data = CStr(Hex(Text8.Text))
End Select
If Err Then '显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
If Option11.value Then
Cmd = "08"
Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd)
Else
Cmd = "07"
Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
End If
End Sub
Private Function CRC16(data() As Byte) As String
Dim CRC16Lo As Byte, CRC16Hi As Byte 'CRC寄存器
Dim CL As Byte, CH As Byte '多项式码&HA001
Dim CRCLo As String, CRCHi As String
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For i = 0 To UBound(data)
CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
For Flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2 '高位右移一位
CRC16Lo = CRC16Lo \ 2 '低位右移一位
If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
CRC16Lo = CRC16Lo Or &H80 '则低位字节右移后前面补1
End If '否则自动补0
If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next Flag
Next i
If Len(Hex(CRC16Hi)) = 1 Then
CRCHi = "0" + Hex(CRC16Hi)
Else
CRCHi = Hex(CRC16Hi)
End If
If Len(Hex(CRC16Lo)) = 1 Then
CRCLo = "0" + Hex(CRC16Lo)
Else
CRCLo = Hex(CRC16Lo)
End If
CRC16 = CRCLo + CRCHi
End Function
这是工控网上另一牛人编的，我试了半天也试不出来，不过可用做大侠您参考。
可以看看我的软件- Modbus,支持OPC ,内含Modbus驱动,能够进行数据类型转换.
在VB里实现浮点数据转换比较困难,建议通过c语言实现,通过dll或控件方式调用.
c语言如下:
case DT_R4:
{ //4字节实数－－－－已经调试过20061113
//4字节实数－－－－－－－－－－-CCommData::DF_HV2143(默认)
ToDataBuf(cByte,4,pBuf);
float* pfValue = (float*)&cByte[0];
strValue.Format(_T("%f"),*pfValue);
return strValue;
break;
／＊
//3.57200
//0x9b 0xa6 0x40 0x64
//HV2 HV1 HV4 HV3
unsigned ｃｈａｒ cByte[5];
cByte[0]=0xa6;
cByte[1]=0x9b;
cByte[2]=0x64;
cByte[3]=0x40;
cByte[4]='\0';
pfValue=(float*)&cByte[0];
/／＊/
}
void CCommData::ToDataBuf(ｃｈａｒ *pcByte, int nLen, const unsigned ｃｈａｒ *pBuf)
{
//3.57200
//0x9b 0xa6 0x40 0x64
//HV2 HV1 HV4 HV3
switch(nLen)
{
case 1:
{
pcByte[0]=pBuf[0];
break;
}
case 2:
{
if(m_unDataFormat == DF_HV12)
{
pcByte[0]=pBuf[0];
pcByte[1]=pBuf[1];
}
else //CCommData::DF_HV21//默认,2个字节整形
{
pcByte[0] = pBuf[1];
pcByte[1] = pBuf[0];
}
break;
}
case 4:
{
if(m_unDataFormat == DF_HV1234)
{
pcByte[0] = pBuf[0];
pcByte[1] = pBuf[1];
pcByte[2] = pBuf[2];
pcByte[3] = pBuf[3];
}
else if(m_unDataFormat == DF_HV2143) //默认,浮点值
{
pcByte[0] = pBuf[1];
pcByte[1] = pBuf[0];
pcByte[2] = pBuf[3];
pcByte[3] = pBuf[2];
}
else if(m_unDataFormat == DF_HV4321)
{
pcByte[0] = pBuf[3];
pcByte[1] = pBuf[2];
pcByte[2] = pBuf[1];
pcByte[3] = pBuf[0];
}
else if(m_unDataFormat == DF_HV3412)
{
pcByte[0] = pBuf[2];
pcByte[1] = pBuf[3];
pcByte[2] = pBuf[0];
pcByte[3] = pBuf[1];
}
break;
}
default:
;
}
}
难点在于浮点数转换
vc中浮点数转换可以通过union来实现union { float f; unsigned ｃｈａｒ b[4]; } u; 也可以通过指针强制转化实现。
在VB很难实现union结构，可以通过CopyMemory(API函数)实现指针强制转化。
例如：
dim f as single
dim b[4] as byte
CopyMemory f,b,4
或
CopyMemory ByVal(VarPtr(f)+0),b(0),1
CopyMemory ByVal(VarPtr(f)+1),b(1),1
CopyMemory ByVal(VarPtr(f)+2),b(2),1
CopyMemory ByVal(VarPtr(f)+3),b(3),1
[3850][2931][2323][4652][2546][2281][2276][5383][5789][3611]
客服
小程序
公众号
工控网智造工程师好文精选
