新的工裝已經完成,利用新的工裝,重新修改了軟件,基本上完成了軟件的調試,現將之前一直無法完成的內容總結下:
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
|