变送器软件

主程序：

Option Explicit Const NAME_COLUMN = 0 Const TYPE_COLUMN = 1 Const SIZE_COLUMN = 2 Const DATE_COLUMN = 3 Dim 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 StartScan End Sub Private 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 Sub Private 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 Sub Private 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 StartScan End Sub Private Sub Command_BUTTON_DP1_Click() Call demarkp(1) End Sub Private Sub Command_BUTTON_DP10_Click() Call demarkp(10) End Sub Private Sub Command_BUTTON_DP2_Click() Call demarkp(2) End Sub Private Sub Command_BUTTON_DP3_Click() Call WaitForScan Call demarkp(3) End Sub Private Sub Command_BUTTON_DP4_Click() Call demarkp(4) End Sub Private Sub Command_BUTTON_DP5_Click() Call demarkp(5) End Sub Private Sub Command_BUTTON_DP6_Click() Call demarkp(6) End Sub Private Sub Command_BUTTON_DP7_Click() Call demarkp(7) End Sub Private Sub Command_BUTTON_DP8_Click() Call demarkp(8) End Sub Private 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 StartScan Exit Sub ErrorHandler: '串口错误 Call StartScan MsgBox "请打开串口", vbOKOnly + vbExclamation, "错误" Comerr = 10 '置位错误状态 End Sub Private 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 StartScan Exit Sub ErrorHandler: '串口错误 Call StartScan MsgBox "请打开串口", vbOKOnly + vbExclamation, "错误" Comerr = 10 '置位错误状态 End Sub Private 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 StartScan End Sub Private 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 StartScan End Sub Private Sub Combo_com_Click() Command_BUTTON_Opencom.Caption = "打开串口" End Sub Private Sub Command_BUTTON_DP0_Click() '写入标定0点 Call demarkp(0) End Sub Private 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