变送器软件

主程序：

Option ExplicitConst NAME_COLUMN = 0Const TYPE_COLUMN = 1Const SIZE_COLUMN = 2Const DATE_COLUMN = 3Dim pre As Integer '参数读取--压力参数读取-标定Dim tmp As Integer '参数读取--温度参数读取--温度Private Sub Command_BUTTON_ALARM_Click() Dim count As Integer Dim send(9) As Byte '定义发送数组 Dim crc(1) As Byte Dim item(1) As Byte Dim address As Integer Dim stemp(3) As Byte Call WaitForScan send(0) = &HFF send(1) = &H10 Call ITB(ALARM, item()) send(2) = item(1) '寄存器地址 send(3) = item(0) send(4) = &H0 '寄存器数量 send(5) = &H2 send(6) = &H4 '字节数 本地址存储下位机地址 为单字节 Call LTB(CByte(Text_ALARM.Text), stemp()) '写入标定压力值 send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) MSComm.Output = send TX_address = ALARM Call StartScanEnd SubPrivate Sub Command_BUTTON_CLEARA_Click() If vbCancel = (MsgBox("是否清除电流标定数据", vbOKCancel + vbExclamation, "提示")) Then Exit Sub '如果 End If Command_BUTTON_DemarkA.Enabled = True Command_BUTTON_CLEARA.Enabled = False Call DemarkA(0#, 0#) End SubPrivate Sub Command_BUTTON_DemarkA_Click() Command_BUTTON_DemarkA.Enabled = False Command_BUTTON_CLEARA.Enabled = True Call DemarkA(CSng(Text_4mA.Text), CSng(Text_20mA.Text))End SubPrivate Sub DemarkA(dat1 As Single, dat2 As Single) Dim count As Byte Dim position As Byte Dim send(16) As Byte '定义发送数组 Dim crc(1) As Byte Dim item(1) As Byte Dim stemp(3) As Byte Dim address As Integer Dim outpercent As Single Call WaitForScan send(0) = CByte(Combo_Meter.Text) send(1) = &H10 Call ITB(U4, item()) send(2) = item(1) send(3) = item(0) send(4) = &H0 send(5) = &H4 send(6) = &H8 Call STB(dat1, stemp()) '写入标定压力值 send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call STB(dat2, stemp()) '写入标定压力值 send(11) = stemp(0) send(12) = stemp(1) send(13) = stemp(2) send(14) = stemp(3) Call CRC16(send(), 14, crc()) send(15) = crc(1) send(16) = crc(0) MSComm.Output = send TX_address = ADD Call StartScanEnd SubPrivate Sub Command_BUTTON_DP1_Click() Call demarkp(1)End SubPrivate Sub Command_BUTTON_DP10_Click() Call demarkp(10)End SubPrivate Sub Command_BUTTON_DP2_Click() Call demarkp(2)End SubPrivate Sub Command_BUTTON_DP3_Click() Call WaitForScan Call demarkp(3)End SubPrivate Sub Command_BUTTON_DP4_Click() Call demarkp(4)End SubPrivate Sub Command_BUTTON_DP5_Click() Call demarkp(5)End SubPrivate Sub Command_BUTTON_DP6_Click() Call demarkp(6)End SubPrivate Sub Command_BUTTON_DP7_Click() Call demarkp(7)End SubPrivate Sub Command_BUTTON_DP8_Click() Call demarkp(8)End SubPrivate Sub Command_BUTTON_DP9_Click() Call demarkp(9)End Sub'温度20度标定值Private Sub Command_BUTTON_DT20_Click() Dim count As Byte Dim demark_A As Byte '轮寻标定位置 Dim send(12) As Byte '定义发送数组 Dim crc(1) As Byte Dim itemp(1) As Byte Dim ltemp(3) As Byte Dim stemp(3) As Byte Dim address As Integer Dim outpercent As Single Call WaitForScan For demark_A = 0 To 30 If Online(demark_A).address <= 0 Or Online(demark_A).address >= 255 Then '地址超范围 则退出 Call StartScan Exit Sub End If send(0) = Online(demark_A).address send(1) = &H10 For count = 0 To 2 Call ITB(UT20, itemp()) '芯片地址 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 '寄存器数，字节数 send(5) = &H2 send(6) = &H4 Call LTB(Online(demark_A).temperature_AD, ltemp()) '写入电压值 send(7) = ltemp(0) send(8) = ltemp(1) send(9) = ltemp(2) send(10) = ltemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) On Error GoTo ErrorHandler '串口操作错误捕捉 MSComm.Output = send TX_address = UT20 Sleep (sleeptime) Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 On Error GoTo ErrorHandler Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误 如果出错则退出操作 Call StartScan MsgBox "通讯出错，请检查连接", vbOKOnly + vbExclamation, "错误" Exit Sub ElseIf Comerr = 1 Then '通讯成功 则退出循环 Exit For End If Next count Next demark_A '仪表地址循环 Call StartScanExit SubErrorHandler: '串口错误 Call StartScan MsgBox "请打开串口", vbOKOnly + vbExclamation, "错误" Comerr = 10 '置位错误状态 End SubPrivate Sub Command_BUTTON_DT60_Click() Dim count As Byte Dim demark_A As Byte '轮寻标定位置 Dim send(12) As Byte '定义发送数组 Dim crc(1) As Byte Dim itemp(1) As Byte Dim ltemp(3) As Byte Dim stemp(3) As Byte Dim address As Integer Dim outpercent As Single Call WaitForScan For demark_A = 0 To 30 If Online(demark_A).address <= 0 Or Online(demark_A).address >= 255 Then '地址超范围 则退出 Call StartScan Exit Sub End If send(0) = Online(demark_A).address send(1) = &H10 For count = 0 To 2 Call ITB(UT60, itemp()) '芯片地址 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 '寄存器数，字节数 send(5) = &H2 send(6) = &H4 Call LTB(Online(demark_A).temperature_AD, ltemp()) '写入电压值 send(7) = ltemp(0) send(8) = ltemp(1) send(9) = ltemp(2) send(10) = ltemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) On Error GoTo ErrorHandler '串口操作错误捕捉 MSComm.Output = send TX_address = UT60 Sleep (sleeptime) Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 On Error GoTo ErrorHandler Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误 如果出错则退出操作 Call StartScan MsgBox "通讯出错，请检查连接", vbOKOnly + vbExclamation, "错误" Exit Sub ElseIf Comerr = 1 Then '通讯成功 则退出循环 Exit For End If Next count Next demark_A '仪表地址循环 Call StartScanExit SubErrorHandler: '串口错误 Call StartScan MsgBox "请打开串口", vbOKOnly + vbExclamation, "错误" Comerr = 10 '置位错误状态 End SubPrivate Sub Command_BUTTON_DTF_Click() Dim count As Byte Dim position As Byte '选择标定点 Dim demark_A As Byte '轮寻标定位置 Dim send(12) As Byte '定义发送数组 Dim sendt(10) As Byte Dim crc(1) As Byte Dim itemp(1) As Byte '将整形转换成2字节型数组 Dim ltemp(3) As Byte '将长整形转换成4字节数组 Dim stemp(3) As Byte '将浮点型转换成4字节数组 Call WaitForScan For count = 0 To 9 If Option_DT(count).Value = True Then position = count Exit For End If Next count For count = 0 To 1 Next count demark_A = 0 '置位轮寻标定位置 For demark_A = 0 To 30 If Online(demark_A).address <= 0 Or Online(demark_A).address >= 255 Then '地址超范围 则退出 Call StartScan Exit Sub End If For count = 0 To 2 send(0) = Online(demark_A).address '置位操作地址 send(1) = &H10 Call ITB(TF + 4 * position, itemp()) '芯片地址 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 '寄存器数，字节数 send(5) = &H2 send(6) = &H4 Call STB(Online(demark_A).press, stemp()) '写入标定压力值 send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) MSComm.Output = send Sleep (sleeptime) Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误 如果出错则退出操作 Call StartScan MsgBox "通讯出错，请检查连接", vbOKOnly + vbExclamation, "错误" Call StartScan Exit Sub ElseIf Comerr = 1 Then '通讯成功 则退出循环 Exit For End If Next count For count = 0 To 2 '写入温度 sendt(0) = Online(demark_A).address '置位操作地址 sendt(1) = &H10 Call ITB(TTEM + 2 * position, itemp()) '芯片地址 sendt(2) = itemp(1) sendt(3) = itemp(0) sendt(4) = &H0 '寄存器数，字节数 sendt(5) = &H1 sendt(6) = &H2 Call ITB(CInt(Online(demark_A).temperature * 10#), itemp()) '写入标定压力值 sendt(7) = itemp(0) sendt(8) = itemp(1) Call CRC16(sendt(), 8, crc()) sendt(9) = crc(1) sendt(10) = crc(0) MSComm.Output = sendt Sleep (sleeptime) Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误 如果出错则退出操作 Call StartScan MsgBox "通讯出错，请检查连接", vbOKOnly + vbExclamation, "错误" Exit Sub ElseIf Comerr = 1 Then '通讯成功 则退出循环 Exit For End If Next count Next demark_A '仪表地址循环 Call StartScanEnd SubPrivate Sub Command_BUTTON_DTZ_Click() '零点标定 Dim count As Byte Dim position As Byte '选择标定点 Dim demark_A As Byte '轮寻标定位置 Dim send(12) As Byte '定义发送数组 Dim crc(1) As Byte Dim itemp(1) As Byte '将整形转换成2字节型数组 Dim ltemp(3) As Byte '将长整形转换成4字节数组 Dim stemp(3) As Byte '将浮点型转换成4字节数组 Call WaitForScan For count = 0 To 9 If Option_DT(count).Value = True Then position = count Exit For End If Next count demark_A = 0 '置位轮寻标定位置 For demark_A = 0 To 30 If Online(demark_A).address <= 0 Or Online(demark_A).address >= 255 Then '地址超范围 则退出 Call StartScan Exit Sub End If For count = 0 To 2 send(0) = Online(demark_A).address '置位操作地址 send(1) = &H10 Call ITB(TZ + 4 * position, itemp()) '芯片地址 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 '寄存器数，字节数 send(5) = &H2 send(6) = &H4 Call STB(Online(demark_A).press, stemp()) '写入标定压力值 send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) MSComm.Output = send Sleep (sleeptime) Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误 如果出错则退出操作 Call StartScan MsgBox "通讯出错，请检查连接", vbOKOnly + vbExclamation, "错误" Exit Sub ElseIf Comerr = 1 Then '通讯成功 则退出循环 Exit For End If Next count Next demark_A '仪表地址循环 Call StartScanEnd SubPrivate Sub Combo_com_Click() Command_BUTTON_Opencom.Caption = "打开串口"End SubPrivate Sub Command_BUTTON_DP0_Click() '写入标定0点 Call demarkp(0)End SubPrivate Sub Command_BUTTON_ExitA_Click() '退出固定电流输出模式 此功能与输出电流模式同 以后可精简 Dim crc(1) As Byte Dim item(1) As Byte Dim stemp(3) As Byte Dim send(12) As Byte '定义发送数组 Dim outpercent As Single Call WaitForScan outpercent = 200# '输出无效值 send(0) = CByte(Combo_Meter.Text) send(1) = &H10 Call ITB(IOUT, item()) send(2) = item(1) send(3) = item(0) send(4) = &H0 send(5) = &H2 send(6) = &H4 Call STB(outpercent, stemp()) '写入标定压力值 send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) MSComm.Output = send TX_address = ADD Call StartScanEnd SubPrivate Sub Command_BUTTON_OPENCOM_Click() If MSComm.PortOpen Then MSComm.PortOpen = False On Error GoTo ErrorHandler MSComm.CommPort = Combo_com.ListIndex + 1 MSComm.InputMode = comInputModeBinary MSComm.InputLen = 0 MSComm.RThreshold = 1 MSComm.SThreshold = 0 MSComm.PortOpen = True On Error GoTo ErrorHandler Command_BUTTON_Opencom.Caption = "串口已打开"Exit SubErrorHandler: MsgBox "打开串口时出错", vbOKOnly + vbExclamation, "错误"End SubPrivate Sub Command_BUTTON_OutA_Click() Dim count As Byte Dim position As Byte Dim send(12) As Byte '定义发送数组 Dim crc(1) As Byte Dim item(1) As Byte Dim stemp(3) As Byte Dim address As Integer Dim outpercent As Single Call WaitForScan For count = 0 To 6 If Option_IOut(count).Value = True Then position = count Exit For End If Next count '确定输出电流值 Select Case position '计算输出百分比 Case 0 outpercent = -0.0125 Case 1 outpercent = 0# Case 2 outpercent = 25# Case 3 outpercent = 50# Case 4 outpercent = 75# Case 5 outpercent = 100# Case 6 outpercent = 100.05 Case Else outpercent = -0.0125 End Select send(0) = CByte(Combo_Meter.Text) send(1) = &H10 Call ITB(IOUT, item()) 'ITB将整形转换成2字节型 send(2) = item(1) send(3) = item(0) send(4) = &H0 send(5) = &H2 send(6) = &H4 Call STB(outpercent, stemp()) '写入标定压力值 '将浮点型转换成4字节型 send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) MSComm.Output = send TX_address = ADD Call StartScan End SubPrivate Sub Command_Button_PR_Click() Label_RP1.Caption = "AD采集值" Label_RP2.Caption = "标定点" Label_RP3.Caption = "" Text_D03.Visible = False Text_D13.Visible = False Text_D23.Visible = False Text_D33.Visible = False Text_D43.Visible = False Text_D53.Visible = False Text_D63.Visible = False Text_D73.Visible = False Text_D83.Visible = False Text_D93.Visible = False Text_D103.Visible = False Text_D01.Visible = True Text_D02.Visible = True Command_BUTTON_TP(0).Visible = True Choose_TR_PR = 1 '当单击压力参数读取时，Choose_PR_TR=1 触发标志 Timer_press_AD.Enabled = True End SubPrivate Sub Command_BUTTON_READADD_Click() '采用公共地址读取仪表地址 Dim count As Integer Dim send(7) As Byte '定义发送数组 Dim crc(1) As Byte Dim item(1) As Byte Call WaitForScan Text_RAdd.Text = 0 send(0) = &HFF send(1) = &H3 Call ITB(ADD, item()) send(2) = item(1) send(3) = item(0) send(4) = &H0 send(5) = &H1 Call CRC16(send(), 5, crc()) send(6) = crc(1) send(7) = crc(0) MSComm.Output = send TX_address = ADD Call StartScan End Sub'芯片复位，本功能将清除芯片内所有数据Private Sub Command_BUTTON_RESET_Click() Dim count As Integer Dim send(9) As Byte '定义发送数组 Dim crc(1) As Byte Dim item(1) As Byte Dim address As Integer Call WaitForScan If vbCancel = (MsgBox("本功能将使芯片置于初始状态，芯片内所有数据都将被清除，是否继续", vbOKCancel + vbExclamation, "提示")) Then Exit Sub '询问是否继续清除 End If send(0) = &HFF send(1) = &H10 Call ITB(ULOCK, item()) send(2) = item(1) '寄存器地址 send(3) = item(0) send(4) = &H0 '寄存器数量 send(5) = &H1 send(6) = &H1 '字节数 本地址存储下位机地址 为单字节 send(7) = &H0 Call CRC16(send(), 7, crc()) send(8) = crc(1) send(9) = crc(0) MSComm.Output = send TX_address = ULOCK Call StartScan End SubPrivate Sub Command_BUTTON_Scan_Click() Call WaitForScan '停止其他扫描 Timer_SCAN.Enabled = True '扫描仪表 顺序扫描地址End SubPrivate Sub Command_BUTTON_SETADD_Click() '采用公共地址设定仪表地址 Dim count As Integer Dim send(9) As Byte '定义发送数组 Dim crc(1) As Byte Dim item(1) As Byte Dim address As Integer Call WaitForScan send(0) = &HFF send(1) = &H10 Call ITB(ADD, item()) send(2) = item(1) '寄存器地址 send(3) = item(0) send(4) = &H0 '寄存器数量 send(5) = &H1 send(6) = &H1 '字节数 本地址存储下位机地址 为单字节 send(7) = CByte(Text_RAdd.Text) Call CRC16(send(), 7, crc()) send(8) = crc(1) send(9) = crc(0) MSComm.Output = send TX_address = ADD Call StartScan End SubPrivate Sub Command_Button_TR_Click() Label_RP1.Caption = "温度" Label_RP2.Caption = "零点" Label_RP3.Caption = "满程" Text_D03.Visible = True Text_D13.Visible = True Text_D23.Visible = True Text_D33.Visible = True Text_D43.Visible = True Text_D53.Visible = True Text_D63.Visible = True Text_D73.Visible = True Text_D83.Visible = True Text_D93.Visible = True Text_D103.Visible = True Text_D01.Visible = False Text_D02.Visible = False Text_D03.Visible = False Command_BUTTON_TP(0).Visible = False Choose_TR_PR = 0 '当单击温度参数读取时，Choose_PR_TR=0 触发标志 Timer_Temp_Read.Enabled = True End SubPrivate Sub Command19_Click() Dim data(3) As Byte Dim temp As Long data(0) = &H25 data(1) = &H52 data(2) = &H9A data(3) = &H44 temp = BTS(data()) temp = 0 End SubPrivate Sub Form_Load() Dim count As Integer Dim str As String str = "COM" For count = 1 To 12 '添加串口 Combo_com.AddItem str & count Next count scanaddP = 1 '置位扫描位置 End SubPrivate Sub M_ALL_Click() SSTab.Tab = 0End SubPrivate Sub M_DI_Click() SSTab.Tab = 1End SubPrivate Sub M_DP_Click() SSTab.Tab = 2End SubPrivate Sub M_DT_Click() SSTab.Tab = 3End SubPrivate Sub M_Exit_Click() Unload Form_mainEnd SubPrivate Sub M_Online_Click() SSTab.Tab = 4End SubPrivate Sub M_Parameter_Click() SSTab.Tab = 5End SubPrivate Sub MSComm_OnComm() '串口数据接收函数 Dim count As Long Dim counttemp As Long Dim tmpBuf() As Byte Dim crc(1) As Byte Dim i As Integer Dim tmpData(1) As Byte '温度 Dim tmpDataZ(3) As Byte '零点 Dim tmpDataF(3) As Byte '满程 Dim preAdData(3) As Byte 'AD采集值 Dim preData(3) As Byte '标定点 Sleep (50) If MSComm.CommEvent = comEvReceive Then '接收数据流处理 Erase RxData '清空数组 Erase TxData '清空数组 tmpBuf = MSComm.Input counttemp = UBound(tmpBuf) For count = 0 To counttemp RxData(count) = tmpBuf(count) Next count '串口接收数据 If RxData(1) = &H3 Then '03读寄存器命令处理 Call CRC16(RxData(), RxData(2) + 2, crc()) If (RxData(RxData(2) + 4) = crc(0)) And (RxData(RxData(2) + 3) = crc(1)) Then 'CRC校验成功 Comerr = 1 '通讯正常 通过CRC校验判定写入是否成功 '综合参数设置--读取地址 If (TX_address = 40001) Or (TX_address = 0) Then '地址匹配成功 For count = 0 To 30 If (Online(count).address = 0) Or (Online(count).address = RxData(0)) Then '地址匹配 继续处理 Dim st2(1) As Byte Dim st4(3) As Byte Online(count).address = RxData(0) st4(3) = RxData(3) st4(2) = RxData(4) st4(1) = RxData(5) st4(0) = RxData(6) Online(count).final = BTS(st4) '数据转换 赋值给在线仪表 st4(3) = RxData(7) st4(2) = RxData(8) st4(1) = RxData(9) st4(0) = RxData(10) Online(count).temperature = BTS(st4) '数据转换 赋值给在线仪表 st4(3) = RxData(11) st4(2) = RxData(12) st4(1) = RxData(13) st4(0) = RxData(14) Online(count).press_AD = BTL(st4) '数据转换 赋值给在线仪表 st4(3) = RxData(15) st4(2) = RxData(16) st4(1) = RxData(17) st4(0) = RxData(18) Online(count).press = BTS(st4) '数据转换 赋值给在线仪表 st4(3) = RxData(19) st4(2) = RxData(20) st4(1) = RxData(21) st4(0) = RxData(22) Online(count).temperature_AD = BTL(st4) '数据转换 赋值给在线仪表 Exit For End If Next count ElseIf (TX_address <= &H10FF) And (TX_address >= &H1000) Then If TX_address = ADD Then '单表读取及设定地址处理 Text_RAdd.Text = RxData(3) Exit Sub End If For counttemp = 0 To 29 '选择当前操作地址 If Online(counttemp).address = RxData(0) Then Exit For End If Next counttemp Select Case Choose_TR_PR Case 0 '温度参数读取 For count = 0 To (RxData(2) - 1) '将数据转存 DemarcateT(counttemp).demarcate(TX_address - &H1000 + count) = RxData(3 + count) Next count For i = 0 To 9 tmpData(1) = DemarcateT(counttemp).demarcate(i * 2) tmpData(0) = DemarcateT(counttemp).demarcate(i * 2 + 1) tmpDataZ(0) = DemarcateT(counttemp).demarcate(i * 4 + 20) tmpDataZ(1) = DemarcateT(counttemp).demarcate(i * 4 + 21) tmpDataZ(2) = DemarcateT(counttemp).demarcate(i * 4 + 22) tmpDataZ(3) = DemarcateT(counttemp).demarcate(i * 4 + 23) tmpDataF(0) = DemarcateT(counttemp).demarcate(i * 4 + 60) tmpDataF(1) = DemarcateT(counttemp).demarcate(i * 4 + 61) tmpDataF(2) = DemarcateT(counttemp).demarcate(i * 4 + 62) tmpDataF(3) = DemarcateT(counttemp).demarcate(i * 4 + 63) DemarcateT(counttemp).temperature(i) = BTI(tmpData()) DemarcateT(counttemp).zero(i) = BTS(tmpDataZ()) DemarcateT(counttemp).full(i) = BTS(tmpDataF()) Next i Text_D11.Text = DemarcateT(counttemp).temperature(0) / 10 '溫度 Text_D21.Text = DemarcateT(counttemp).temperature(1) / 10 Text_D31.Text = DemarcateT(counttemp).temperature(2) / 10 Text_D41.Text = DemarcateT(counttemp).temperature(3) / 10 Text_D51.Text = DemarcateT(counttemp).temperature(4) / 10 Text_D61.Text = DemarcateT(counttemp).temperature(5) / 10 Text_D71.Text = DemarcateT(counttemp).temperature(6) / 10 Text_D81.Text = DemarcateT(counttemp).temperature(7) / 10 Text_D91.Text = DemarcateT(counttemp).temperature(8) / 10 Text_D101.Text = DemarcateT(counttemp).temperature(9) / 10 Text_D12.Text = Format(DemarcateT(counttemp).zero(0), "##0.00000") '零點 Text_D22.Text = Format(DemarcateT(counttemp).zero(1), "##0.00000") Text_D32.Text = Format(DemarcateT(counttemp).zero(2), "##0.00000") Text_D42.Text = Format(DemarcateT(counttemp).zero(3), "##0.00000") Text_D52.Text = Format(DemarcateT(counttemp).zero(4), "##0.00000") Text_D62.Text = Format(DemarcateT(counttemp).zero(5), "##0.00000") Text_D72.Text = Format(DemarcateT(counttemp).zero(6), "##0.00000") Text_D82.Text = Format(DemarcateT(counttemp).zero(7), "##0.00000") Text_D92.Text = Format(DemarcateT(counttemp).zero(8), "##0.00000") Text_D102.Text = Format(DemarcateT(counttemp).zero(9), "##0.00000") Text_D13.Text = Format(DemarcateT(counttemp).full(0), "##0.00000") '滿程 Text_D23.Text = Format(DemarcateT(counttemp).full(1), "##0.00000") Text_D33.Text = Format(DemarcateT(counttemp).full(2), "##0.00000") Text_D43.Text = Format(DemarcateT(counttemp).full(3), "##0.00000") Text_D53.Text = Format(DemarcateT(counttemp).full(4), "##0.00000") Text_D63.Text = Format(DemarcateT(counttemp).full(5), "##0.00000") Text_D73.Text = Format(DemarcateT(counttemp).full(6), "##0.00000") Text_D83.Text = Format(DemarcateT(counttemp).full(7), "##0.00000") Text_D93.Text = Format(DemarcateT(counttemp).full(8), "##0.00000") Text_D103.Text = Format(DemarcateT(counttemp).full(9), "##0.00000") Case 1 '压力参数读取 For count = 0 To (RxData(2) - 1) '将数据转存 DemarcateP(counttemp).demarcate(TX_address - &H1080 + count) = RxData(3 + count) Next count For i = 0 To 10 preAdData(0) = DemarcateP(counttemp).demarcate(i * 4) preAdData(1) = DemarcateP(counttemp).demarcate(i * 4 + 1) preAdData(2) = DemarcateP(counttemp).demarcate(i * 4 + 2) preAdData(3) = DemarcateP(counttemp).demarcate(i * 4 + 3) preData(0) = DemarcateP(counttemp).demarcate(i * 4 + 44) preData(1) = DemarcateP(counttemp).demarcate(i * 4 + 45) preData(2) = DemarcateP(counttemp).demarcate(i * 4 + 46) preData(3) = DemarcateP(counttemp).demarcate(i * 4 + 47) DemarcateP(counttemp).voltage(i) = BTL(preAdData()) DemarcateP(counttemp).offset(i) = BTS(preData()) Next i Text_D01.Text = DemarcateP(counttemp).voltage(0) 'AD采集值 Text_D11.Text = DemarcateP(counttemp).voltage(1) Text_D21.Text = DemarcateP(counttemp).voltage(2) Text_D31.Text = DemarcateP(counttemp).voltage(3) Text_D41.Text = DemarcateP(counttemp).voltage(4) Text_D51.Text = DemarcateP(counttemp).voltage(5) Text_D61.Text = DemarcateP(counttemp).voltage(6) Text_D71.Text = DemarcateP(counttemp).voltage(7) Text_D81.Text = DemarcateP(counttemp).voltage(8) Text_D91.Text = DemarcateP(counttemp).voltage(9) Text_D101.Text = DemarcateP(counttemp).voltage(10) Text_D02.Text = Format(DemarcateP(counttemp).offset(0), "##0.00000") '标定点 Text_D12.Text = Format(DemarcateP(counttemp).offset(1), "##0.00000") Text_D22.Text = Format(DemarcateP(counttemp).offset(2), "##0.00000") Text_D32.Text = Format(DemarcateP(counttemp).offset(3), "##0.00000") Text_D42.Text = Format(DemarcateP(counttemp).offset(4), "##0.00000") Text_D52.Text = Format(DemarcateP(counttemp).offset(5), "##0.00000") Text_D62.Text = Format(DemarcateP(counttemp).offset(6), "##0.00000") Text_D72.Text = Format(DemarcateP(counttemp).offset(7), "##0.00000") Text_D82.Text = Format(DemarcateP(counttemp).offset(8), "##0.00000") Text_D92.Text = Format(DemarcateP(counttemp).offset(9), "##0.00000") Text_D102.Text = Format(DemarcateP(counttemp).offset(10), "##0.00000") End Select End If End If End If If RxData(1) = &H10 Then '10写命令 Call CRC16(RxData(), 5, crc()) 'CRC校验 If RxData(6) = crc(1) And RxData(7) = crc(0) Then '校验成功 Comerr = 1 '通讯正常 End If End If End IfEnd SubPrivate Sub Online_Click() SSTab.Tab = 4End SubPrivate Sub Option_0_06_Click() Text_D0.Text = Format(0, "##0.0") Text_D1.Text = Format(0.1, "##0.0") Text_D2.Text = Format(0.2, "##0.0") Text_D3.Text = Format(0.3, "##0.0") Text_D4.Text = Format(0.4, "##0.0") Text_D5.Text = Format(0.5, "##0.0") Text_D6.Text = Format(0.6, "##0.0") Text_D7.Text = Format(0, "##0.0") Text_D8.Text = Format(0, "##0.0") Text_D9.Text = Format(0, "##0.0") Text_D10.Text = Format(0, "##0.0") preAD = 0End SubPrivate Sub Option_0_10_Click() Text_D0.Text = Format(0, "##0.0") Text_D1.Text = Format(1, "##0.0") Text_D2.Text = Format(2, "##0.0") Text_D3.Text = Format(3, "##0.0") Text_D4.Text = Format(4, "##0.0") Text_D5.Text = Format(5, "##0.0") Text_D6.Text = Format(6, "##0.0") Text_D7.Text = Format(7, "##0.0") Text_D8.Text = Format(8, "##0.0") Text_D9.Text = Format(9, "##0.0") Text_D10.Text = Format(10, "##0.0") preAD = 1End SubPrivate Sub Option_0_100_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(1#, "##0.0") Text_D2.Text = Format(2#, "##0.0") Text_D3.Text = Format(3#, "##0.0") Text_D4.Text = Format(4#, "##0.0") Text_D5.Text = Format(5#, "##0.0") Text_D6.Text = Format(6#, "##0.0") Text_D7.Text = Format(7#, "##0.0") Text_D8.Text = Format(8#, "##0.0") Text_D9.Text = Format(9#, "##0.0") Text_D10.Text = Format(10#, "##0.0") preAD = 2End SubPrivate Sub Option_0_1000_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(10#, "##0.0") Text_D2.Text = Format(20#, "##0.0") Text_D3.Text = Format(30#, "##0.0") Text_D4.Text = Format(40#, "##0.0") Text_D5.Text = Format(50#, "##0.0") Text_D6.Text = Format(60#, "##0.0") Text_D7.Text = Format(70#, "##0.0") Text_D8.Text = Format(80#, "##0.0") Text_D9.Text = Format(90#, "##0.0") Text_D10.Text = Format(100#, "##0.0") preAD = 3End SubPrivate Sub Option_0_16_Click() Text_D0.Text = Format(0, "##0.0") Text_D1.Text = Format(0.2, "##0.0") Text_D2.Text = Format(0.4, "##0.0") Text_D3.Text = Format(0.6, "##0.0") Text_D4.Text = Format(0.8, "##0.0") Text_D5.Text = Format(1#, "##0.0") Text_D6.Text = Format(1.2, "##0.0") Text_D7.Text = Format(1.4, "##0.0") Text_D8.Text = Format(1.6, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 4End SubPrivate Sub Option_0_160_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(2#, "##0.0") Text_D2.Text = Format(4#, "##0.0") Text_D3.Text = Format(6#, "##0.0") Text_D4.Text = Format(8#, "##0.0") Text_D5.Text = Format(10#, "##0.0") Text_D6.Text = Format(12#, "##0.0") Text_D7.Text = Format(14#, "##0.0") Text_D8.Text = Format(16#, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 5End SubPrivate Sub Option_0_25_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(0.5, "##0.0") Text_D2.Text = Format(1#, "##0.0") Text_D3.Text = Format(1.5, "##0.0") Text_D4.Text = Format(2#, "##0.0") Text_D5.Text = Format(2.5, "##0.0") Text_D6.Text = Format(0#, "##0.0") Text_D7.Text = Format(0#, "##0.0") Text_D8.Text = Format(0#, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 6End SubPrivate Sub Option_0_250_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(5#, "##0.0") Text_D2.Text = Format(10#, "##0.0") Text_D3.Text = Format(15#, "##0.0") Text_D4.Text = Format(20#, "##0.0") Text_D5.Text = Format(25#, "##0.0") Text_D6.Text = Format(0#, "##0.0") Text_D7.Text = Format(0#, "##0.0") Text_D8.Text = Format(0#, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 7End SubPrivate Sub Option_0_40_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(0.5, "##0.0") Text_D2.Text = Format(1#, "##0.0") Text_D3.Text = Format(1.5, "##0.0") Text_D4.Text = Format(2#, "##0.0") Text_D5.Text = Format(2.5, "##0.0") Text_D6.Text = Format(3#, "##0.0") Text_D7.Text = Format(3.5, "##0.0") Text_D8.Text = Format(4#, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 8End SubPrivate Sub Option_0_400_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(5#, "##0.0") Text_D2.Text = Format(10#, "##0.0") Text_D3.Text = Format(15#, "##0.0") Text_D4.Text = Format(20#, "##0.0") Text_D5.Text = Format(25#, "##0.0") Text_D6.Text = Format(30#, "##0.0") Text_D7.Text = Format(35#, "##0.0") Text_D8.Text = Format(40#, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 9End SubPrivate Sub Option_0_60_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(1#, "##0.0") Text_D2.Text = Format(2#, "##0.0") Text_D3.Text = Format(3#, "##0.0") Text_D4.Text = Format(4#, "##0.0") Text_D5.Text = Format(5#, "##0.0") Text_D6.Text = Format(60#, "##0.0") Text_D7.Text = Format(0#, "##0.0") Text_D8.Text = Format(0#, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 10End SubPrivate Sub Option_0_600_Click() Text_D0.Text = Format(0#, "##0.0") Text_D1.Text = Format(10#, "##0.0") Text_D2.Text = Format(20#, "##0.0") Text_D3.Text = Format(30#, "##0.0") Text_D4.Text = Format(40#, "##0.0") Text_D5.Text = Format(50#, "##0.0") Text_D6.Text = Format(60#, "##0.0") Text_D7.Text = Format(0#, "##0.0") Text_D8.Text = Format(0#, "##0.0") Text_D9.Text = Format(0#, "##0.0") Text_D10.Text = Format(0#, "##0.0") preAD = 11End Sub'压力仪表标定采用查询串口方式'每次发送命令等待50mS读取数据，通讯成功则继续，否则重新发送，两次以上错误则认为仪表离线，提示检查连接'按仪表循环标定，直至最后一个在线仪表写入完毕Private Sub demarkp(demarkp As Byte) '仪表压力标定 Dim demark_A As Byte '轮寻标定位置 Dim count As Integer Dim send(12) As Byte '定义发送数组 Dim crc(1) As Byte Dim itemp(1) As Byte '将整形转换成2字节型数组 Dim ltemp(3) As Byte '将长整形转换成4字节数组 Dim stemp(3) As Byte '将浮点型转换成4字节数组 Call WaitForScan demark_A = 0 '置位轮寻标定位置 For demark_A = 0 To 30 If Online(demark_A).address <= 0 Or Online(demark_A).address >= 255 Then '地址超范围 则退出 Call StartScan Exit Sub End If For count = 0 To 2 send(0) = Online(demark_A).address '置位操作地址 send(1) = &H10 Call ITB(LB + 4 * demarkp, itemp()) '芯片地址 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 '寄存器数，字节数 send(5) = &H2 send(6) = &H4 Select Case demarkp Case 0 Call STB(CSng(Text_D0.Text), stemp()) '写入标定压力值 Case 1 Call STB(CSng(Text_D1.Text), stemp()) '写入标定压力值 Case 2 Call STB(CSng(Text_D2.Text), stemp()) '写入标定压力值 Case 3 Call STB(CSng(Text_D3.Text), stemp()) '写入标定压力值 Case 4 Call STB(CSng(Text_D4.Text), stemp()) '写入标定压力值 Case 5 Call STB(CSng(Text_D5.Text), stemp()) '写入标定压力值 Case 6 Call STB(CSng(Text_D6.Text), stemp()) '写入标定压力值 Case 7 Call STB(CSng(Text_D7.Text), stemp()) '写入标定压力值 Case 8 Call STB(CSng(Text_D8.Text), stemp()) '写入标定压力值 Case 9 Call STB(CSng(Text_D9.Text), stemp()) '写入标定压力值 Case 10 Call STB(CSng(Text_D10.Text), stemp()) '写入标定压力值 End Select send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) On Error GoTo ErrorHandler '串口操作错误捕捉 MSComm.Output = send Sleep (sleeptime) Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误 如果出错则退出操作 Call StartScan MsgBox "通讯出错，请检查连接", vbOKOnly + vbExclamation, "错误" Exit Sub ElseIf Comerr = 1 Then '通讯成功 则退出循环 Exit For End If Next count For count = 0 To 2 Call ITB(LBIN + 4 * demarkp, itemp()) '芯片地址 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 '寄存器数，字节数 send(5) = &H2 send(6) = &H4 Call LTB(Online(demark_A).press_AD, ltemp()) '写入电压值 send(7) = ltemp(0) send(8) = ltemp(1) send(9) = ltemp(2) send(10) = ltemp(3) Call CRC16(send(), 10, crc()) send(11) = crc(1) send(12) = crc(0) On Error GoTo ErrorHandler '串口操作错误捕捉 MSComm.Output = send Sleep (sleeptime) Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误 如果出错则退出操作 Call StartScan MsgBox "通讯出错，请检查连接", vbOKOnly + vbExclamation, "错误" Exit Sub ElseIf Comerr = 1 Then '通讯成功 则退出循环 Exit For End If Next count Next demark_A '仪表地址循环 Call StartScanExit SubErrorHandler: '串口错误 Call StartScan MsgBox "请打开串口", vbOKOnly + vbExclamation, "错误" Comerr = 10 '置位错误状态 End SubPrivate Sub Parameter_Click() SSTab.Tab = 5End SubPrivate Sub Timer_LISTRENOVATE_Timer() '刷新列表及更新仪表数据 Dim count As Integer Dim itm As ListItem Dim send(7) As Byte '定义发送数组 Dim crc(1) As Byte ListView_Display.ListItems.Clear For count = 0 To 30 '更新仪表数据 If Online(count).address <> 0 Then Set itm = ListView_Display.ListItems.ADD() itm.Text = Online(count).address itm.SubItems(1) = Format(Online(count).final, "##0.00000") itm.SubItems(2) = Format(Online(count).press, "##0.00000") itm.SubItems(3) = Format(Online(count).temperature, "##0.00000") itm.SubItems(4) = Online(count).press_AD Else Exit For End If Next count If Online(scanaddP).address <> 0 Then send(0) = Online(scanaddP).address send(1) = &H3 send(2) = &H0 send(3) = &H0 send(4) = &H0 send(5) = &HA Call CRC16(send(), 5, crc()) send(6) = crc(1) send(7) = crc(0) On Error GoTo ErrorHandler scanaddP = scanaddP + 1 MSComm.Output = send TX_address = 0 Else scanaddP = 0 End IfExit SubErrorHandler: Call StartScan Timer_SCAN.Enabled = False MsgBox "请打开串口", vbOKOnly + vbExclamation, "错误"End SubPrivate Sub Timer_SCAN_Timer() '每500ms中断一次 按地址一次扫描 Dim count As Integer Dim send(7) As Byte '定义发送数组 Dim crc(1) As Byte If scanaddP < 31 Then send(0) = scanaddP scanaddP = scanaddP + 1 If ProgressBar.Value < 300 Then ProgressBar.Value = ProgressBar.Value + 10 End If Else scanaddP = 1 '将扫描到的地址填入地址栏 For count = 0 To 30 If Online(count).address <> 0 Then Combo_Meter.AddItem Online(count).address, count End If Next count ProgressBar.Value = 0 Timer_SCAN.Enabled = False MsgBox "扫描仪表结束", vbOKOnly, "提示" Timer_LISTRENOVATE.Enabled = TrueExit Sub End If send(1) = &H3 send(2) = &H0 send(3) = &H0 send(4) = &H0 send(5) = &HA Call CRC16(send(), 5, crc()) send(6) = crc(1) send(7) = crc(0) On Error GoTo ErrorHandler MSComm.Output = send TX_address = 0Exit SubErrorHandler: Call StartScan Timer_SCAN.Enabled = False MsgBox "请打开串口", vbOKOnly + vbExclamation, "错误"End SubPrivate Sub WaitForScan() Dim clearInput() As Byte Timer_LISTRENOVATE.Enabled = False Sleep (sleeptime) '发送命令之前停止扫描 Call MSComm_OnCommEnd SubPrivate Sub StartScan() Sleep (sleeptime) Timer_LISTRENOVATE.Enabled = TrueEnd Sub'参数读取--单点修改Private Sub Command_BUTTON_TP_Click(Index As Integer) Dim count As Integer Select Case Choose_TR_PR Case 0 For count = 0 To 2 Call temp_ValueWrite(Index) Comerr = 10 '置位错误标志，如果通讯成功则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数，查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误，如果出错则退出操作 Exit Sub ElseIf Comerr = 1 Then '通讯成功，退出循环 Exit For End If Next count For count = 0 To 2 Call tempZ_ValueWrite(Index) Comerr = 10 '置位错误标志，如果通讯成功则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数，查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误，如果出错则退出操作 Exit Sub ElseIf Comerr = 1 Then '通讯成功，退出循环 Exit For End If Next count For count = 0 To 2 Call tempF_ValueWrite(Index) Comerr = 10 '置位错误标志，如果通讯成功则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数，查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误，如果出错则退出操作 Exit Sub ElseIf Comerr = 1 Then '通讯成功，退出循环 Exit For End If Next count Case 1 For count = 0 To 2 Call press_ADValueWrite(Index) Comerr = 10 '置位错误标志，如果通讯成功则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数，查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误，如果出错则退出操作 Exit Sub ElseIf Comerr = 1 Then '通讯成功，退出循环 Exit For End If Next count For count = 0 To 2 Call press_SpotWrite(Index) Comerr = 10 '置位错误标志，如果通讯成功则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数，查询是否有中断发生 If Comerr = 10 And count = 2 Then '检测通讯错误，如果出错则退出操作 Exit Sub ElseIf Comerr = 1 Then '通讯成功，退出循环 Exit For End If Next count End SelectEnd Sub'参数读取--压力参数读取--读出Private Sub Timer_press_AD_Timer() Dim send(7) As Byte Dim crc(1) As Byte Dim itemp(1) As Byte Call WaitForScan send(0) = CByte(Val(Combo_Meter.Text)) '在线仪表首地址 If pre < 11 Then TX_address = &H1080 + pre * 10 send(1) = &H3 '03读寄存器命令 Call ITB(LBIN, itemp()) '压力AD采集值 地址 send(2) = itemp(1) send(3) = itemp(0) + pre * 10 send(4) = &H0 send(5) = &HA '寄存器数 Call CRC16(send(), 5, crc()) 'CRC校验 send(6) = crc(1) send(7) = crc(0) MSComm.Output = send Sleep 300 pre = pre + 1 Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 Else pre = 0 Timer_press_AD.Enabled = False End If Call StartScanEnd Sub'参数读取--温度参数读取--读出Private Sub Timer_Temp_Read_timer() Dim send(7) As Byte Dim crc(1) As Byte Dim itemp(1) As Byte Call WaitForScan send(0) = CByte(Val(Combo_Meter.Text)) If tmp < 10 Then TX_address = &H1000 + tmp * 10 send(1) = &H3 '03读寄存器命令 Call ITB(TTEM, itemp()) send(2) = itemp(1) send(3) = itemp(0) + tmp * 10 send(4) = &H0 send(5) = &HA '寄存器数 Call CRC16(send(), 5, crc()) 'CRC校验 send(6) = crc(1) send(7) = crc(0) MSComm.Output = send Sleep 300 tmp = tmp + 1 Comerr = 10 '置位错误标志 如果通讯成功 则本位置被修改 Call MSComm_OnComm '调用串口数据处理函数 查询是否有中断发生 ElseIf tmp > 9 Then tmp = 0 Timer_Temp_Read.Enabled = False End IfEnd Sub'参数读取--压力参数读取--AD采集值写入Private Sub press_ADValueWrite(Index As Integer) Dim send(12) As Byte Dim itemp(1) As Byte Dim stemp(3) As Byte Dim crc(1) As Byte Dim count As Integer send(0) = CByte(Val(Combo_Meter.Text)) '在线仪表首地址 send(1) = &H10 '10写寄存器命令 Call ITB(LBIN + 4 * Index, itemp()) '地址，写压力 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 send(5) = &H2 '寄存器数目 send(6) = &H4 '字节数 Select Case Index Case 0 Call LTB(CSng(Text_D01.Text), stemp()) Case 1 Call LTB(CSng(Text_D11.Text), stemp()) Case 2 Call LTB(CSng(Text_D21.Text), stemp()) Case 3 Call LTB(CSng(Text_D31.Text), stemp()) Case 4 Call LTB(CSng(Text_D41.Text), stemp()) Case 5 Call LTB(CSng(Text_D51.Text), stemp()) Case 6 Call LTB(CSng(Text_D61.Text), stemp()) Case 7 Call LTB(CSng(Text_D71.Text), stemp()) Case 8 Call LTB(CSng(Text_D81.Text), stemp()) Case 9 Call LTB(CSng(Text_D91.Text), stemp()) Case 10 Call LTB(CSng(Text_D101.Text), stemp()) End Select send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) 'CRC校验 send(11) = crc(1) send(12) = crc(0) MSComm.Output = send Sleep 500End Sub'参数读取--压力参数读取--标定点写入Private Sub press_SpotWrite(Index As Integer) Dim send(12) As Byte Dim itemp(1) As Byte Dim stemp(3) As Byte Dim crc(1) As Byte Dim count As Integer send(0) = CByte(Val(Combo_Meter.Text)) '在线仪表首地址 send(1) = &H10 '10写寄存器命令 Call ITB(LB + 4 * Index, itemp()) '地址，写压力 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 send(5) = &H2 '寄存器数目 send(6) = &H4 '字节数 Select Case Index Case 0 Call STB(CSng(Text_D02.Text), stemp()) Case 1 Call STB(CSng(Text_D12.Text), stemp()) Case 2 Call STB(CSng(Text_D22.Text), stemp()) Case 3 Call STB(CSng(Text_D32.Text), stemp()) Case 4 Call STB(CSng(Text_D42.Text), stemp()) Case 5 Call STB(CSng(Text_D52.Text), stemp()) Case 6 Call STB(CSng(Text_D62.Text), stemp()) Case 7 Call STB(CSng(Text_D72.Text), stemp()) Case 8 Call STB(CSng(Text_D82.Text), stemp()) Case 9 Call STB(CSng(Text_D92.Text), stemp()) Case 10 Call STB(CSng(Text_D102.Text), stemp()) End Select send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) 'CRC校验 send(11) = crc(1) send(12) = crc(0) MSComm.Output = send Sleep 500End Sub'参数读取--温度参数读取--温度写入Private Sub temp_ValueWrite(Index As Integer) Dim send(10) As Byte Dim itemp(1) As Byte Dim stemp(1) As Byte Dim crc(1) As Byte send(0) = CByte(Val(Combo_Meter.Text)) '在线仪表首地址 send(1) = &H10 '10写寄存器命令 Call ITB(TTEM + 2 * (Index - 1), itemp()) '地址，写温度 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 send(5) = &H1 '寄存器数目 send(6) = &H2 '字节数 Select Case Index Case 1 Call ITB(CSng(Text_D11.Text), stemp()) Case 2 Call ITB(CSng(Text_D21.Text), stemp()) Case 3 Call ITB(CSng(Text_D31.Text), stemp()) Case 4 Call ITB(CSng(Text_D41.Text), stemp()) Case 5 Call ITB(CSng(Text_D51.Text), stemp()) Case 6 Call ITB(CSng(Text_D61.Text), stemp()) Case 7 Call ITB(CSng(Text_D71.Text), stemp()) Case 8 Call ITB(CSng(Text_D81.Text), stemp()) Case 9 Call ITB(CSng(Text_D91.Text), stemp()) Case 10 Call ITB(CSng(Text_D101.Text), stemp()) End Select send(7) = stemp(0) send(8) = stemp(1) Call CRC16(send(), 8, crc()) 'CRC校验 send(9) = crc(1) send(10) = crc(0) MSComm.Output = send Sleep 500 End Sub'参数读取--温度参数读取--零点写入Private Sub tempZ_ValueWrite(Index As Integer) Dim send(12) As Byte Dim itemp(1) As Byte Dim stemp(3) As Byte Dim crc(1) As Byte send(0) = CByte(Val(Combo_Meter.Text)) '在线仪表首地址 send(1) = &H10 '10写寄存器命令 Call ITB(TZ + 4 * (Index - 1), itemp()) '地址，写温度 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 send(5) = &H1 '寄存器数目 send(6) = &H2 '字节数 Select Case Index Case 1 Call STB(CSng(Text_D12.Text), stemp()) Case 2 Call STB(CSng(Text_D22.Text), stemp()) Case 3 Call STB(CSng(Text_D32.Text), stemp()) Case 4 Call STB(CSng(Text_D42.Text), stemp()) Case 5 Call STB(CSng(Text_D52.Text), stemp()) Case 6 Call STB(CSng(Text_D62.Text), stemp()) Case 7 Call STB(CSng(Text_D72.Text), stemp()) Case 8 Call STB(CSng(Text_D82.Text), stemp()) Case 9 Call STB(CSng(Text_D92.Text), stemp()) Case 10 Call STB(CSng(Text_D102.Text), stemp()) End Select send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) 'CRC校验 send(11) = crc(1) send(12) = crc(0) MSComm.Output = send Sleep 500 End Sub'参数读取--温度参数读取--满程写入Private Sub tempF_ValueWrite(Index As Integer) Dim send(12) As Byte Dim itemp(1) As Byte Dim stemp(3) As Byte Dim crc(1) As Byte send(0) = CByte(Val(Combo_Meter.Text)) '在线仪表首地址 send(1) = &H10 '10写寄存器命令 Call ITB(TF + 4 * (Index - 1), itemp()) '地址，写温度 send(2) = itemp(1) send(3) = itemp(0) send(4) = &H0 send(5) = &H1 '寄存器数目 send(6) = &H2 '字节数 Select Case Index Case 1 Call STB(CSng(Text_D13.Text), stemp()) Case 2 Call STB(CSng(Text_D23.Text), stemp()) Case 3 Call STB(CSng(Text_D33.Text), stemp()) Case 4 Call STB(CSng(Text_D43.Text), stemp()) Case 5 Call STB(CSng(Text_D53.Text), stemp()) Case 6 Call STB(CSng(Text_D63.Text), stemp()) Case 7 Call STB(CSng(Text_D73.Text), stemp()) Case 8 Call STB(CSng(Text_D83.Text), stemp()) Case 9 Call STB(CSng(Text_D93.Text), stemp()) Case 10 Call STB(CSng(Text_D103.Text), stemp()) End Select send(7) = stemp(0) send(8) = stemp(1) send(9) = stemp(2) send(10) = stemp(3) Call CRC16(send(), 10, crc()) 'CRC校验 send(11) = crc(1) send(12) = crc(0) MSComm.Output = send Sleep 500End Sub

模块一：

Option ExplicitDeclare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) '联合体实现 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'sleep 函数实现'数据校验Public Sub CRC16(data() As Byte, count As Byte, dat() As Byte) Dim CRC16Hi As Byte Dim CRC16Lo As Byte CRC16Hi = &HFF CRC16Lo = &HFF Dim i As Integer Dim iIndex As Long For i = 0 To count iIndex = CRC16Lo Xor data(i) CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) '低位处理 CRC16Hi = GetCRCHi(iIndex) '高位处理 Next i dat(0) = CRC16Hi dat(1) = CRC16Lo End Sub 'CRC低位字节值表 Function GetCRCLo(Ind As Long) As Byte GetCRCLo = Choose(Ind + 1, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40) End Function 'CRC高位字节值表 Function GetCRCHi(Ind As Long) As Byte GetCRCHi = Choose(Ind + 1, &H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, &HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, &H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, &H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, &H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, &H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, &HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, _&H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, &H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, &H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, &HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, &H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, &H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, &H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, &H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40) End Function '传入连续4个字节首地址 返回有符号长整型值Public Function BTL(data() As Byte) As Long Dim ReturnData As Long CopyMemory ReturnData, data(0), 4 BTL = ReturnDataEnd Function'传入连续4个字节首地址 返回浮点型值Public Function BTS(data() As Byte) As Single Dim ReturnData As Single CopyMemory ReturnData, data(0), 4 BTS = ReturnDataEnd Function'传入2字节首地址 返回整形值Public Function BTI(data() As Byte) As Integer Dim ReturnData As Integer CopyMemory ReturnData, data(0), 2 BTI = ReturnDataEnd Function'将有符号长整形转换成4字节型Public Sub LTB(sdat As Long, data() As Byte) CopyMemory data(0), sdat, 4End Sub'将浮点型转换成4字节型Public Sub STB(sdata As Single, data() As Byte) CopyMemory data(0), sdata, 4End Sub'将整形转换成2字节型Public Sub ITB(sdata As Integer, data() As Byte) CopyMemory data(0), sdata, 2End Sub

模块二：

Option ExplicitPublic RxData(0 To 300) As BytePublic TxData(0 To 34) As BytePublic Const LBIN = &H1080 '有符号长整形 线标电压Public Const LB = &H10AC '浮点型 线标偏移量Public Const U4 = &H10D8 '浮点型 4mA电流Public Const U20 = &H10DC '浮点型 20mA电流Public Const IOUT = &H10E0 '浮点型 电流输出Public Const UT20 = &H10E4 '有符号长整形 20度温度标定Public Const UT60 = &H10E8 '有符号长整形 60度温度标定Public Const ALARM = &H10EC '浮点型 密度表专用报警点 设为0时无效Public Const ULOCK = &H10F0 '字节型 写入非0xA0值 软件刷新Public Const TTEM = &H1000 '有符号整形 温度10倍Public Const TZ = &H1014 '浮点型 零点Public Const TF = &H103C '浮点型 满程Public Const ADD = &H1064 '无符号字节 地址Public Const dat = &H1065 '连续三个字节型 日期Public Const NO = &H1068 '字节型 仪表编号Public Const sleeptime = 300 '串口休眠时间Public scanaddP As Byte '当前扫描位置Public TX_address As Integer '发送寄存器地址Public demark_A As Byte '轮寻标定位置Public Comerr As Byte '串口通讯错误标志 1 通讯正常 10 通讯错误 通过CRC校验判定写入是否成功Public Choose_TR_PR As Boolean '触发标志 0 温度参数读取 1 压力参数读取Public Choose_AD_PValue As Boolean '触发标志--压力参数读取 true AD采集值 false 压力值Public Choose_Single_Temp As BytePublic Pre_AD As Boolean Public Type ONL '在线仪表结构体 address As Byte final As Single '温补压力 temperature As Single '温度 press_AD As Long '压力AD采集值 press As Single '线补压力 temperature_AD As Long '温度AD采集值End TypePublic Online(0 To 30) As ONL '在线仪表数组Public state As Byte '当前标定状态 1：线性标定 2：温度标定 Public Type DT temperature(9) As Single zero(9) As Single full(9) As Single demarcate(255) As Byte '将单片机内数据映射至此 每次列表刷新重新计算显示值 系统操作本区域 End TypePublic DemarcateT(0 To 30) As DT Public Type DP voltage(10) As Long offset(10) As Single demarcate(255) As Byte '将单片机内数据映射至此 End Type Public DemarcateP(0 To 20) As DP

哎，帮我看看啊。呜呜~