新的工装已经完成，利用新的工装，重新修改了软件，基本上完成了软件的调试，现将之前一直无法完成的内容总结下：
1.之前的实际数据量与图形标识的百分比对不上号，现将百分比按实际数据量进行划分，就可以一一一对应；
2.增加了超过误差要求的数据数量的统计，如果错误数据超过设订值，提示报警（声音和文本双重提示）；
3.增加了四条偏差范围标准线，在必要的时候可以同时打印标准线；
4.打印功能可以实现打印及图像保存
现将设计的效果图及代码保存如下，必要的时候可以调出来参考：
波形代码：
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Sub Command4_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击.wav", &H0) '声音
Command4.Visible = False
Me.PrintForm '实现打印功能
Exit Sub
End Sub
Private Sub Text12_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击.wav", &H0) '声音
Dim myArray(6) As String '显示数据数组
Dim MyColor(6) As Long '颜色控制数组
Dim MyCaption(150) As String 'X轴显示数组
Dim MyLegend(2) As String
Dim I As Integer
Dim K As Integer
K = Int(frmMain.Text11.Text)
For I = 0 To K 'K为实际数据量
If I = Int(K / 10) Then
MyCaption(I) = "10%"
ElseIf I = Int((K / 10) * 2) Then 'INT为取整，只有取整才可以显示百分比
MyCaption(I) = "20%"
ElseIf I = Int((K / 10) * 3) Then
MyCaption(I) = "30%"
ElseIf I = Int((K / 10) * 4) Then
MyCaption(I) = "40%"
ElseIf I = Int((K / 10) * 5) Then
MyCaption(I) = "50%"
ElseIf I = Int((K / 10) * 6) Then
MyCaption(I) = "60%"
ElseIf I = Int((K / 10) * 7) Then
MyCaption(I) = "70%"
ElseIf I = Int((K / 10) * 8) Then
MyCaption(I) = "80%"
ElseIf I = Int((K / 10) * 9) Then
MyCaption(I) = "90%"
ElseIf I = K Then
MyCaption(I) = "100%"
End If
Next I
'Me.ForeColor = vbRed
'myArray(0) = Text1.Text
'MyColor(0) = vbRed
myArray(1) = Text2.Text
MyColor(1) = vbBlack 'vbBlue
myArray(2) = Text3.Text
MyColor(2) = vbBlack 'vbGreen
myArray(3) = Text15.Text
MyColor(3) = vbGreen 'vbBlack
myArray(4) = Text19.Text
MyColor(4) = vbRed
myArray(5) = Text20.Text
MyColor(5) = vbGreen 'vbBlack
myArray(6) = Text21.Text
MyColor(6) = vbRed
Chart1.MaxValue = 500 'Y轴最大值
Chart1.MinValue = 0 'Y轴最小值
Chart1.DrawGraph myArray, MyColor, MyCaption '显示图形
End Sub
控制面板代码：
'Private Const SND_ASYNC = &H1 '播放音频的同时将控制转回应用程序中
'Private Const SND_LOOP = &H8 '循环播放模式
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Sub cmdClear_Click() '按清除键
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
If Adodc4.Recordset.RecordCount <= 0 Then '如果数据为空，直接退出
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\报警2.wav", &H0) '声音警示
MsgBox "无数据，不必麻烦清除"
GoTo JP
End If
Text7.Text = Clear
Text9.Text = Clear
Text13.Text = Clear
Text14.Text = Clear
Text15.Text = Clear
Text11.Text = Clear
Text10.Text = Clear
Text2.Text = Clear
Text3.Text = Clear
Text4.Text = Clear
Text5.Text = Clear
Text1.Text = Clear
Dim bytTemp(0) As Byte
ReDim bytReceiveByte(0)
intReceiveLen = 0
Call InputManage(bytTemp, 0)
Call GetDisplayText
Call display
Adodc4.Recordset.MoveFirst '指针指向第一行
bijiao2: Adodc4.Recordset.Delete '删除数据
Adodc4.Recordset.MoveFirst '指针再次指向第一行
If Adodc4.Recordset.EOF Then '判断是否是最后一个数据
Else:
GoTo bijiao2 '如果不是，继续删除数据，如果是，退出删除
End If
JP: End Sub
Private Sub cmdReceive_Click() '按接收键
Dim I As Integer
Dim J As Integer
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
If blnReceiveFlag Then
If Not blnAutoSendFlag And Not blnReceiveFlag Then
frmMain.ctrMSComm.PortOpen = False
End If
frmMain.cmdReceive.Caption = "开始接收"
Else
If Not frmMain.ctrMSComm.PortOpen Then
frmMain.ctrMSComm.CommPort = intPort
frmMain.ctrMSComm.Settings = strSet
frmMain.ctrMSComm.PortOpen = True
End If
frmMain.ctrMSComm.InputLen = 0
frmMain.ctrMSComm.InputMode = 0
frmMain.ctrMSComm.InBufferCount = 0
frmMain.ctrMSComm.RThreshold = 1
frmMain.cmdReceive.Caption = "停止接收"
End If
blnReceiveFlag = Not blnReceiveFlag
End Sub
Private Sub cmdSetting_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
dlgSetting.Show
frmMain.Hide
End Sub
Private Sub Command1_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音警示
If Adodc4.Recordset.RecordCount <= 0 Then '如果数据为空，直接退出
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音警示
MsgBox "无数据，请重新检测"
GoTo jq
ElseIf Adodc4.Recordset.RecordCount < 50 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音警示
MsgBox "检测速度太快，数据量不足，请清除数据并重新检测！"
Text13.Text = Clear
Text14.Text = Clear
Text15.Text = Clear
GoTo jq
End If
Dim I As Integer
Dim J As Integer
Dim M As Integer
Dim N As Integer
Dim L As Integer
Dim I1 As Integer
Dim J1 As Integer
Dim M1 As Integer
Dim N1 As Integer
Dim L1 As Integer
Dim yy1 As Integer
Dim yy2 As Integer
Dim B1 As Integer
Dim B2 As Integer
Dim B3 As Integer
Dim B4 As Integer
Dim OK As Integer
Dim OK2 As Integer
Dim OKA As Integer
Dim OKB As Integer
Dim OKC As Integer
Dim OKD As Integer
Dim OKE As Integer
'***************************************************************
'清除数据为空和重复的数据
Adodc4.Recordset.MoveFirst
B1 = 0
shangkong:
B2 = Val(Adodc4.Recordset.Fields("信号编号"))
If B2 = B1 Then
Adodc4.Recordset.Delete
Else: B1 = B2
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo shangkong
End If
'**************************************************************
'清除不合理的数据
Adodc4.Recordset.MoveFirst
B3 = 0
gogo:
B4 = Val(Adodc4.Recordset.Fields("信号1"))
If B4 - B3 < 20 Then
Adodc4.Recordset.Delete
Else: B3 = B4
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo gogo
End If
'*****************************************************************
'重新计算有效数据数量
Text11.Text = Adodc4.Recordset.RecordCount '计算数据的数量
If Adodc4.Recordset.RecordCount < 50 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音警示
MsgBox "检测速度太快，数据量不足，请清除数据并重新检测！"
Text13.Text = Clear
Text14.Text = Clear
Text15.Text = Clear
GoTo jq
End If
'*****************************************************************
Adodc4.Recordset.MoveFirst
M = 0
bijiao:
I = Val(Adodc4.Recordset.Fields("信号3")) / 2 'Val将字符串数据转换为数值数据
J = Val(Adodc4.Recordset.Fields("信号2"))
If J > I Then
N = (J - I) / 50
ElseIf J <= I Then
N = (I - J) / 50
End If
Text7.Text = Int(N) 'Adodc4.Recordset.Fields("电压2") = N
If N > M Then
M = N
L = Adodc4.Recordset.Fields("信号编号")
yy1 = Adodc4.Recordset.Fields("信号2")
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao '指针循环
End If
Text7.Text = M
Text9.Text = L
xiaoboxing.Text13.Text = L
xiaoboxing.Text14.Text = yy1
'*******************************************************************************
Adodc4.Recordset.MoveFirst
OK = 0
bijiao1: I1 = Val(Adodc4.Recordset.Fields("偏差值"))
If I1 >= 20 Then
OK = OK + 1
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao1 '指针循环
End If
Text12.Text = OK
'*******************************************************************************
'Adodc4.Recordset.MoveFirst
'M1 = 0
'bijiao1: I1 = Val(Adodc4.Recordset.Fields("信号2")) / 2
' J1 = Val(Adodc4.Recordset.Fields("信号3"))
' If J1 > I1 Then
' N1 = (J1 - I1) / 50
' ElseIf J1 <= I1 Then
' N1 = (I1 - J1) / 50
' End If
' If N1 > M1 Then
' M1 = N1
' L1 = Adodc4.Recordset.Fields("信号编号")
' yy2 = Adodc4.Recordset.Fields("信号3")
' End If
'Adodc4.Recordset.MoveNext '判断指针位置
'If Adodc4.Recordset.EOF Then
' Adodc4.Recordset.MoveLast
' ElseIf Adodc4.Recordset.BOF Then
' Adodc4.Recordset.MoveFirst
'Else: GoTo bijiao1 '指针循环
'End If
'Text8.Text = M1
'Text6.Text = L1
xiaoboxing.Text17.Text = L1
xiaoboxing.Text18.Text = yy2
'*********************************************************************************
If M > 20 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\GT.wav", &H0) '声音警示
MsgBox "下行信号1误差超出要求，请清除数据，更换产品，重新检测！"
GoTo jq
ElseIf OK > 5 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\GT.wav", &H0) '声音警示
MsgBox "下行信号误差量超出要求，请清除数据，重新检测！"
GoTo jq
End If
Adodc4.Recordset.MoveFirst
OK1 = Int(Text11.Text)
OKA = ((375 + 150) / 10) '参考线起点数据,根据偏差标准的不同设置相应的参数
OKB = ((375 - 150) / 10)
OKC = ((750 + 150) / 10)
OKD = ((750 - 150) / 10)
Text17.Text = OKA
Text23.Text = OKB
Text24.Text = OKC
Text25.Text = OKD
OKE = 0
Text13.Text = (Adodc4.Recordset.Fields("信号1")) / 10
Text14.Text = (Adodc4.Recordset.Fields("信号2")) / 10
Text15.Text = (Adodc4.Recordset.Fields("信号3")) / 10
bijiao2: OKE = OKE + 1
OKA = ((375 + 150) + (1545 / OK1) * OKE) / 10 '参考线数据递增量
OKB = ((375 - 150) + (1545 / OK1) * OKE) / 10
OKC = ((750 + 150) + (3090 / OK1) * OKE) / 10
OKD = ((750 - 150) + (3090 / OK1) * OKE) / 10
Text13.Text = Text13.Text + "," & (Adodc4.Recordset.Fields("信号1")) / 10 '数据线1数据
Text14.Text = Text14.Text + "," & (Adodc4.Recordset.Fields("信号2")) / 10 '数据线2数据
Text15.Text = Text15.Text + "," & (Adodc4.Recordset.Fields("信号3")) / 10 '数据线3数据
Text17.Text = Text17.Text + "," & (OKA) '参考线1数据
Text23.Text = Text23.Text + "," & (OKB) '参考线2数据
Text24.Text = Text24.Text + "," & (OKC) '参考线3数据
Text25.Text = Text25.Text + "," & (OKD) '参考线4数据
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao2 '指针循环
End If
For OKE = 0 To AK1
Next OKE
'frmMain.Hide
xiaoboxing.Show
xiaoboxing.Text8.Text = "产品名称：" + Text16.Text
xiaoboxing.Text1.Text = Text13.Text
xiaoboxing.Text2.Text = Text14.Text
xiaoboxing.Text3.Text = Text15.Text
xiaoboxing.Text15.Text = Text17.Text
xiaoboxing.Text19.Text = Text23.Text
xiaoboxing.Text20.Text = Text24.Text
xiaoboxing.Text21.Text = Text25.Text
xiaoboxing.Text4.Text = "生产日期：" + Text18.Text
xiaoboxing.Text5.Text = "产品型号：" + Text19.Text
xiaoboxing.Text9.Text = "产品序列号：" + Text22.Text
xiaoboxing.Text10.Text = "检验员号：" + Text21.Text
xiaoboxing.Text7.Text = "下行最大偏差：" + Text7.Text + "%"
jq: End Sub
Private Sub Command2_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
Dim I As Integer
Dim J As Integer
Dim M As Integer
Dim N As Integer
Dim L As Integer
Dim I1 As Integer
Dim J1 As Integer
Dim M1 As Integer
Dim N1 As Integer
Dim L1 As Integer
If Adodc4.Recordset.RecordCount <= 0 Then '如果数据为空，直接退出
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\提示.wav", &H0) '声音警示
MsgBox "无数据，请重新检测"
GoTo jq
ElseIf Adodc4.Recordset.RecordCount < 45 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\报警.wav", &H0) '声音警示
MsgBox "检测速度太快，数据量不足，请清除数据并重新检测！"
Text13.Text = Clear
Text14.Text = Clear
Text15.Text = Clear
GoTo jq
End If
Adodc4.Recordset.MoveFirst
M = 0
bijiao: I = Val(Adodc4.Recordset.Fields("信号1")) / 2
J = Val(Adodc4.Recordset.Fields("信号2"))
If J > I Then
N = (J - I)
ElseIf J <= I Then
N = (I - J)
End If
If N > M Then
M = N
L = Adodc4.Recordset.Fields("信号编号")
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao '指针循环
End If
Text7.Text = M
Text9.Text = L
Adodc4.Recordset.MoveFirst
M1 = 0
bijiao1: I1 = Val(Adodc4.Recordset.Fields("信号1"))
J1 = Val(Adodc4.Recordset.Fields("信号3"))
If J1 > I1 Then
N1 = (J1 - I1)
ElseIf J1 <= I1 Then
N1 = (I1 - J1)
End If
If N1 > M1 Then
M1 = N1
L1 = Adodc4.Recordset.Fields("信号编号")
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao1 '指针循环
End If
Text8.Text = M1
Text6.Text = L1
'Text12.Text = Adodc4.Recordset.RecordCount '计算数据的数量
'Adodc4.Recordset.MoveFirst
'bijiao: If Adodc4.Recordset.Fields("信号编号") = 0 Then '删除编码位0的数据
'Adodc4.Recordset.Delete
'ElseIf Adodc4.Recordset.Fields("信号1") = Adodc4.Recordset.Fields("信号2") Then '删除错误数据
'Adodc4.Recordset.Delete
'End If
'Adodc4.Recordset.MoveNext '判断指针位置
'If Adodc4.Recordset.EOF Then
' Adodc4.Recordset.MoveLast
' ElseIf Adodc4.Recordset.BOF Then
' Adodc4.Recordset.MoveFirst
'Else: GoTo bijiao '指针循环
'End If
jq: End Sub
Private Sub Command3_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
End
End Sub
Private Sub Command4_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
frmMain.Hide
shujuchaxun.Show
End Sub
Private Sub Command5_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
cpsz.Show
frmMain.Hide
'初始化combobox控件
End Sub
Private Sub Command6_Click() '***************************数据备份
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
If frmMain.Text22.Text = "" Then
MsgBox "序列号为空，请填写序列号"
GoTo gogo
End If
If beifen.Adodc1.Recordset.Fields("信号1数据") <> "" Then
GoTo BJ1
End If
beifen.Adodc1.Recordset.MoveLast
bgbg: If beifen.Adodc1.Recordset.Fields("产品序列号") = frmMain.Text22.Text Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音
MsgBox "提示：序列号与最后一组数据相同，原数据将被替换！"
beifen.Adodc1.Recordset.Fields("检测时间") = frmMain.Text18.Text
beifen.Adodc1.Recordset.Fields("产品型号") = frmMain.Text19.Text
beifen.Adodc1.Recordset.Fields("产品编号") = frmMain.Text20.Text
beifen.Adodc1.Recordset.Fields("检验员") = frmMain.Text21.Text
beifen.Adodc1.Recordset.Fields("信号1数据") = frmMain.Text13.Text
beifen.Adodc1.Recordset.Fields("信号2数据") = frmMain.Text14.Text
beifen.Adodc1.Recordset.Fields("信号3数据") = frmMain.Text15.Text
beifen.Adodc1.Recordset.Fields("产品名称") = frmMain.Text16.Text
beifen.Adodc1.Recordset.Update
'*************************************************增加下拉选项
shujuchaxun.Combo1.AddItem beifen.Adodc1.Recordset.Fields("检测时间")
shujuchaxun.Combo2.AddItem beifen.Adodc1.Recordset.Fields("产品型号")
shujuchaxun.Combo3.AddItem beifen.Adodc1.Recordset.Fields("产品编号")
shujuchaxun.Combo4.AddItem beifen.Adodc1.Recordset.Fields("产品序列号")
shujuchaxun.Combo5.AddItem beifen.Adodc1.Recordset.Fields("检测时间")
shujuchaxun.Combo6.AddItem beifen.Adodc1.Recordset.Fields("产品型号")
shujuchaxun.Combo7.AddItem beifen.Adodc1.Recordset.Fields("产品编号")
shujuchaxun.Combo8.AddItem beifen.Adodc1.Recordset.Fields("产品序列号")
MsgBox "数据备份完成！"
GoTo gogo
Else
'***********************************************************************
'如何判断序列号数据重复
BJ1: beifen.Adodc1.Recordset.MoveFirst
bjbj1: If beifen.Adodc1.Recordset.Fields("产品序列号") = frmMain.Text22.Text Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音
MsgBox "序列号重复，请核实并确定序列号"
GoTo gogo
End If
beifen.Adodc1.Recordset.MoveNext '判断指针位置
If beifen.Adodc1.Recordset.EOF Then
beifen.Adodc1.Recordset.MoveLast
ElseIf beifen.Adodc1.Recordset.BOF Then
beifen.Adodc1.Recordset.MoveFirst
Else: GoTo bjbj1 '指针循环
End If
'***********************************************************************
beifen.Adodc1.Recordset.AddNew
beifen.Adodc1.Recordset.Fields("产品序列号") = frmMain.Text22.Text
beifen.Adodc1.Recordset.Fields("检测时间") = frmMain.Text18.Text
beifen.Adodc1.Recordset.Fields("产品型号") = frmMain.Text19.Text
beifen.Adodc1.Recordset.Fields("产品编号") = frmMain.Text20.Text
beifen.Adodc1.Recordset.Fields("检验员") = frmMain.Text21.Text
beifen.Adodc1.Recordset.Fields("信号1数据") = frmMain.Text13.Text
beifen.Adodc1.Recordset.Fields("信号2数据") = frmMain.Text14.Text
beifen.Adodc1.Recordset.Fields("信号3数据") = frmMain.Text15.Text
beifen.Adodc1.Recordset.Fields("产品名称") = frmMain.Text16.Text
beifen.Adodc1.Recordset.Update
'*************************************************增加下拉选项
shujuchaxun.Combo1.AddItem beifen.Adodc1.Recordset.Fields("检测时间")
shujuchaxun.Combo2.AddItem beifen.Adodc1.Recordset.Fields("产品型号")
shujuchaxun.Combo3.AddItem beifen.Adodc1.Recordset.Fields("产品编号")
shujuchaxun.Combo4.AddItem beifen.Adodc1.Recordset.Fields("产品序列号")
shujuchaxun.Combo5.AddItem beifen.Adodc1.Recordset.Fields("检测时间")
shujuchaxun.Combo6.AddItem beifen.Adodc1.Recordset.Fields("产品型号")
shujuchaxun.Combo7.AddItem beifen.Adodc1.Recordset.Fields("产品编号")
shujuchaxun.Combo8.AddItem beifen.Adodc1.Recordset.Fields("产品序列号")
MsgBox "新立——数据备份完成！"
GoTo gogo
End If
gogo: End Sub
Private Sub Command7_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音
beifen.Show
frmMain.Hide
End Sub
Private Sub Command8_Click()
Dim plays As Long
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\单击2.wav", &H0) '声音警示
If Adodc4.Recordset.RecordCount <= 0 Then '如果数据为空，直接退出
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音警示
MsgBox "无数据，请重新检测"
GoTo jq2
ElseIf Adodc4.Recordset.RecordCount < 50 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音警示
MsgBox "检测速度太快，数据量不足，请清除数据并重新检测！"
Text13.Text = Clear
Text14.Text = Clear
Text15.Text = Clear
GoTo jq2
End If
Dim I As Integer
Dim J As Integer
Dim M As Integer
Dim N As Integer
Dim L As Integer
Dim I1 As Integer
Dim J1 As Integer
Dim M1 As Integer
Dim N1 As Integer
Dim L1 As Integer
Dim yy1 As Integer
Dim yy2 As Integer
Dim B1 As Integer
Dim B2 As Integer
Dim B3 As Integer
Dim B4 As Integer
'***************************************************************
'清除数据为空和重复的数据
Adodc4.Recordset.MoveFirst
B1 = 0
shangkong:
B2 = Val(Adodc4.Recordset.Fields("信号编号"))
If B2 = B1 Then
Adodc4.Recordset.Delete
Else: B1 = B2
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo shangkong
End If
'**************************************************************
'清除不合理的数据
Adodc4.Recordset.MoveFirst
B3 = 3840
gogo:
B4 = Val(Adodc4.Recordset.Fields("信号2"))
If B4 >= B3 Then
Adodc4.Recordset.Delete
Else: B3 = B4
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo gogo
End If
'*****************************************************************
'重新计算有效数据数量
Text11.Text = Adodc4.Recordset.RecordCount '计算数据的数量
If Adodc4.Recordset.RecordCount < 40 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\警告.wav", &H0) '声音警示
MsgBox "检测速度太快，数据量不足，请清除数据并重新检测！"
Text13.Text = Clear
Text14.Text = Clear
Text15.Text = Clear
GoTo jq2
End If
'*****************************************************************
Adodc4.Recordset.MoveFirst
M = 0
bijiao: I = Val(Adodc4.Recordset.Fields("信号2")) / 2 'Val将字符串数据转换为数值数据
J = Val(Adodc4.Recordset.Fields("信号3"))
If J > I Then
N = (J - I) / 4096 / 500
ElseIf J <= I Then
N = (I - J) / 4096 / 500
End If
If N > M Then
M = N
L = Adodc4.Recordset.Fields("信号编号")
yy1 = Adodc4.Recordset.Fields("信号2")
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao '指针循环
End If
Text7.Text = M
Text9.Text = L
xiaoboxing.Text13.Text = L
xiaoboxing.Text14.Text = yy1
'*******************************************************************************
Adodc4.Recordset.MoveFirst
M1 = 0
bijiao1: I1 = Val(Adodc4.Recordset.Fields("信号2")) / 2
J1 = Val(Adodc4.Recordset.Fields("信号3"))
If J1 > I1 Then
N1 = (J1 - I1) / 4096 / 50
ElseIf J1 <= I1 Then
N1 = (I1 - J1) / 4096 / 50
End If
If N1 > M1 Then
M1 = N1
L1 = Adodc4.Recordset.Fields("信号编号")
yy2 = Adodc4.Recordset.Fields("信号3")
End If
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao1 '指针循环
End If
Text8.Text = M1
Text6.Text = L1
xiaoboxing.Text17.Text = L1
xiaoboxing.Text18.Text = yy2
'*********************************************************************************
If M > 20 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\GT.wav", &H0) '声音警示
MsgBox "下行信号1误差超出要求，请清除数据，更换产品，重新检测！"
GoTo jq2
ElseIf M1 > 20 Then
plays = sndPlaySound("D:\汽车电子油门检测软件\sy\GT.wav", &H0) '声音警示
MsgBox "上行信号2误差超出要求，请清除数据，更换产品，重新检测！"
GoTo jq2
End If
Adodc4.Recordset.MoveFirst
Text13.Text = (Adodc4.Recordset.Fields("信号1")) / 10
Text14.Text = (Adodc4.Recordset.Fields("信号2")) / 10
Text15.Text = (Adodc4.Recordset.Fields("信号3")) / 10
bijiao2: Text13.Text = Text13.Text + "," & (Adodc4.Recordset.Fields("信号1")) / 10
Text14.Text = Text14.Text + "," & (Adodc4.Recordset.Fields("信号2")) / 10
Text15.Text = Text15.Text + "," & (Adodc4.Recordset.Fields("信号3")) / 10
Adodc4.Recordset.MoveNext '判断指针位置
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.MoveLast
ElseIf Adodc4.Recordset.BOF Then
Adodc4.Recordset.MoveFirst
Else: GoTo bijiao2 '指针循环
End If
'frmMain.Hide
xiaoboxing.Show
xiaoboxing.Text8.Text = "产品名称：" + Text16.Text
xiaoboxing.Text1.Text = Text13.Text
xiaoboxing.Text2.Text = Text14.Text
xiaoboxing.Text3.Text = Text15.Text
xiaoboxing.Text4.Text = "生产日期：" + Text18.Text
xiaoboxing.Text5.Text = "产品型号：" + Text19.Text
xiaoboxing.Text9.Text = "产品序列号：" + Text22.Text
xiaoboxing.Text10.Text = "检验员号：" + Text21.Text
xiaoboxing.Text6.Text = "信号2最大误差：" + Text7.Text + "%"
xiaoboxing.Text7.Text = "信号1最大误差：" + Text8.Text + "%"
jq2: End Sub
Private Sub ctrMSComm_OnComm()
Dim bytInput() As Byte
Dim intInputLen As Integer
Select Case frmMain.ctrMSComm.CommEvent
Case comEvReceive
If blnReceiveFlag Then
If Not frmMain.ctrMSComm.PortOpen Then
frmMain.ctrMSComm.CommPort = intPort
frmMain.ctrMSComm.Settings = strSet
frmMain.ctrMSComm.PortOpen = True
End If
'此处添加处理接收的代码
frmMain.ctrMSComm.InputMode = comInputModeBinary
intInputLen = frmMain.ctrMSComm.InBufferCount
ReDim bytInput(intInputLen)
bytInput = frmMain.ctrMSComm.Input
Call InputManage(bytInput, intInputLen)
Call GetDisplayText
Call display
If Not blnAutoSendFlag And Not blnReceiveFlag Then
frmMain.ctrMSComm.PortOpen = False
End If
End If
End Select
End Sub
'初始化
'*****************************************
Private Sub Form_Load()
'Command8.vbBlue
intReceiveLen = 0 '接收字符个数
intHexWidth = 9 '显示字符宽度
intHexChk = 1 '开显示
'初始化显示视窗
frmMain.fraHexEditBackground.Left = frmMain.txtReceive.Left + 30
frmMain.fraHexEditBackground.Top = frmMain.txtReceive.Top + 30
frmMain.fraHexEditBackground.Width = frmMain.txtReceive.Width - 60
frmMain.fraHexEditBackground.Height = frmMain.txtReceive.Height - 60
frmMain.txtHexEditAddress.Top = 0
frmMain.txtHexEditHex.Top = 0
frmMain.txtHexEditText.Top = 0
frmMain.txtBlank.Top = 0
frmMain.txtHexEditAddress.Height = frmMain.fraHexEditBackground.Height
frmMain.txtHexEditHex.Height = frmMain.fraHexEditBackground.Height
frmMain.txtHexEditText.Height = frmMain.fraHexEditBackground.Height
frmMain.txtBlank.Height = frmMain.fraHexEditBackground.Height
'初始化滚动条
frmMain.vsclHexEdit.Width = 2 * ChrWidth
frmMain.vsclHexEdit.Top = frmMain.fraHexEditBackground.Top
frmMain.vsclHexEdit.Left = frmMain.fraHexEditBackground.Left + frmMain.fraHexEditBackground.Width - frmMain.vsclHexEdit.Width
frmMain.vsclHexEdit.Height = frmMain.fraHexEditBackground.Height
frmMain.hsclHexEdit.Height = ChrHeight
frmMain.hsclHexEdit.Left = frmMain.fraHexEditBackground.Left
frmMain.hsclHexEdit.Top = frmMain.fraHexEditBackground.Top + frmMain.fraHexEditBackground.Height - frmMain.hsclHexEdit.Height
frmMain.hsclHexEdit.Width = frmMain.fraHexEditBackground.Width
'设置滚动条最小和最大滚动
frmMain.vsclHexEdit.Min = 0
frmMain.vsclHexEdit.SmallChange = 1
frmMain.vsclHexEdit.LargeChange = 3
frmMain.vsclHexEdit.Value = 0
frmMain.hsclHexEdit.Min = 0
frmMain.hsclHexEdit.SmallChange = 1
frmMain.hsclHexEdit.LargeChange = 3
frmMain.hsclHexEdit.Value = 0
'显示初始化
Call cmdClear_Click
'初始化串行口
intPort = 1
intTime = 1000
strSet = "2400,n,8,1"
frmMain.ctrMSComm.InBufferSize = 1024
frmMain.ctrMSComm.OutBufferSize = 512
If Not frmMain.ctrMSComm.PortOpen Then
frmMain.ctrMSComm.CommPort = intPort
frmMain.ctrMSComm.Settings = strSet
frmMain.ctrMSComm.PortOpen = True
End If
frmMain.ctrMSComm.PortOpen = False
End Sub
Private Sub hsclHexEdit_Change()
intOriginX = -frmMain.hsclHexEdit.Value * ChrWidth
Call ScrollRedisplay
End Sub
Private Sub sldLenth_Change(Index As Integer)
'intHexWidth = frmMain.sldLenth(0).Value
Call SlideRedisplay
End Sub
Private Sub vsclHexEdit_Change()
intOriginY = frmMain.vsclHexEdit.Value
Call ScrollRedisplay
End Sub
|
