form1.frm

该程序基于RS232串口通讯的激光检测钻头钻孔内径及外径等相关参数从而判断该产品是否为OK/NG

            End
    End If
End Sub

Private Sub mlock_Click()

End Sub

Private Sub mhelp_Click()
On Error Resume Next
Call ShellExecute(frmmain.hwnd, "open", App.Path & "\help.chm", vbNullString, vbNullString, 1)
End Sub

Private Sub mlujin_Click()
dlgSavePath.Show 1
End Sub

Private Sub mout_Click()
On Error Resume Next
Dim dr1, dc1, dr2, dc2, sr1, sc1, sr2, sc2 As Integer
Load Formstatistic
'===========表格格式
Formstatistic.F1Book1.SelStartRow = f1row + 9
Formstatistic.F1Book1.SelEndRow = f1row + 12
Formstatistic.F1Book1.SelStartCol = 1
Formstatistic.F1Book1.SelEndCol = mainmaxcol
Formstatistic.F1Book1.SetBorder 2, 2, 2, 2, 2, 2, vbBlack, vbBlack, vbBlack, vbBlack, vbBlack
Formstatistic.F1Book1.SelStartRow = f1row + 14
Formstatistic.F1Book1.SelEndRow = f1row + 14
Formstatistic.F1Book1.SetBorder 2, 2, 2, 2, 2, 2, vbBlack, vbBlack, vbBlack, vbBlack, vbBlack
Formstatistic.F1Book1.SelStartRow = f1row + 13
Formstatistic.F1Book1.SelEndRow = f1row + 14
Formstatistic.F1Book1.SetBorder 2, 2, 2, 2, 2, 2, vbBlack, vbBlue, vbBlue, vbBlue, vbBlue
'=======================
Formstatistic.F1Book1.TextRC(f1row + 9, 3) = "最大"
Formstatistic.F1Book1.TextRC(f1row + 10, 3) = "最小"
Formstatistic.F1Book1.TextRC(f1row + 11, 3) = "平均"
Formstatistic.F1Book1.TextRC(f1row + 12, 3) = "准备误差"
Formstatistic.F1Book1.TextRC(f1row + 13, 3) = "CP"
Formstatistic.F1Book1.TextRC(f1row + 14, 3) = "CPK"

Formstatistic.Caption = "报表输出--------" & dname.Text
Formstatistic.F1Book1.TextRC(1, 1) = "产品名"
Formstatistic.F1Book1.TextRC(1, 2) = frmmain.dname.Text

Formstatistic.F1Book1.TextRC(4, 1) = "批号"
Formstatistic.F1Book1.TextRC(4, 2) = frmmain.Text1.Text

Formstatistic.F1Book1.TextRC(6, 1) = "作业者"


'Formstatistic.F1Book1.TextRC(2, 3) = "C(OK)"
'Formstatistic.F1Book1.TextRC(2, 4) = "C(NG)"

'If (countok + countng) > 0 Then
'Formstatistic.F1Book1.TextRC(3, 3) = countok & "@" & Format(countok / (countok + countng), "000%")
'Formstatistic.F1Book1.TextRC(3, 4) = countng & "@" & Format(countng / (countok + countng), "000%")
'End If



Formstatistic.F1Book1.Refresh
'------------------统计
For i = 0 To mainmaxcol - 4
Formstatistic.F1Book1.FormulaRC(f1row + 9, i + 4) = "IF(ISERROR(max(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "))" & "," & "0," & "max(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "))"
Formstatistic.F1Book1.FormulaRC(f1row + 10, i + 4) = "IF(ISERROR(min(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "))" & "," & "0," & "min(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "))"
Formstatistic.F1Book1.FormulaRC(f1row + 11, i + 4) = "IF(ISERROR(fixed(AVERAGE(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "),3))" & "," & "0," & "fixed(AVERAGE(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "),3))"
Formstatistic.F1Book1.FormulaRC(f1row + 12, i + 4) = "IF(ISERROR(fixed(STDEV(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "),3))" & "," & "0," & "fixed(STDEV(" & int_char(i + 4) & "11:" & int_char(i + 4) & Val(7 + f1row) & "),3))"
Formstatistic.F1Book1.FormulaRC(f1row + 13, i + 4) = "IF(ISERROR(fixed((" + int_char(i + 4) & "9-" & int_char(i + 4) & "10" & ")/(6*" & int_char(i + 4) & Val(f1row + 12) & "),3))" & "," & "0," & "fixed((" & int_char(i + 4) & "9-" & int_char(i + 4) & "10" & ")/(6*" & int_char(i + 4) & Val(f1row + 12) & "),3))"
 
 sam = "IF(ISERROR(fixed(" & int_char(i + 4) & Val(f1row + 13) & "*(1-ABS(" & int_char(i + 4) & Val(f1row + 11) & "-(" & int_char(i + 4) & "9" & "-(" & int_char(i + 4) & "9-" & int_char(i + 4) & "10)/2))/((" & int_char(i + 4) & "9-" & int_char(i + 4) & "10)/2)),3))"
Formstatistic.F1Book1.FormulaRC(f1row + 14, i + 4) = sam & "," & "0," & "fixed(" & int_char(i + 4) & Val(f1row + 13) & "*(1-ABS(" & int_char(i + 4) & Val(f1row + 11) & "-(" & int_char(i + 4) & "9" & "-(" & int_char(i + 4) & "9-" & int_char(i + 4) & "10)/2))/((" & int_char(i + 4) & "9-" & int_char(i + 4) & "10)/2)),3))"

Next i

dr1 = 8: dc1 = 1
dr2 = f1row + 8: dc2 = F1Book1.MaxCol
sr1 = 1: sc1 = 1
sr2 = f1row + 1: sc2 = F1Book1.MaxCol
Formstatistic.F1Book1.CopyRangeEx Formstatistic.F1Book1.Sheet, dr1, dc1, dr2, dc2, frmmain.F1Book1.SS, frmmain.F1Book1.Sheet, sr1, sc1, sr2, sc2


Formstatistic.F1Book1.SheetName(1) = Trim(dname.Text)
Formstatistic.Show 1
End Sub




Private Sub msaveas_Click()
On Error GoTo ErrHandler
    With Dialog1
        .DialogTitle = "选择文件的保存路径"
        .Filter = "xls文件(*.xls)|*.xls|所有文件(*.*)|*.*"
        .Flags = &H2000
        .ShowSave
    End With
Dialog1.CancelError = True
If Dir(Dialog1.FileName, vbNormal) <> "" Then
    If MsgBox("该文件名已存在，是否覆盖此文件？", vbOKCancel + vbInformation, "提示") = vbOK Then
                Kill Dialog1.FileName
             Else
                Exit Sub
            End If
            End If
    F1Book1.Write Dialog1.FileName, 4
ErrHandler:
       Exit Sub
End Sub

Private Sub mshowbar_Click()
F1Book1.ShowEditBar = Not F1Book1.ShowEditBar
End Sub

Private Sub mstart_Click()
dianjistart
End Sub

Private Sub nbegin_Click()

End Sub

Private Sub mview_Click()
View.Show 1
End Sub

Private Sub savegraph_Click()
On Error Resume Next
ag:
    With Dialog1
        .DialogTitle = "选择文件的保存路径"
        .Filter = "文件(*.bmp)|*.bmp|所有文件(*.*)|*.*"
        .Flags = &H2000
        .ShowSave
    End With
    If Dialog1.FileName <> "" Then
        If Dir(Dialog1.FileName, vbNormal) <> "" Then
            If MsgBox("该文件名已存在，是否覆盖此文件？", vbOKCancel + vbInformation, "提示") = vbOK Then
                Kill Dialog1.FileName
             Else
                'GoTo ag
            End If

        End If
           '  Else
             '   GoTo ag
    End If
    
       SavePicture graph.Image, Dialog1.FileName
End Sub

Private Sub saveto_Click()
savetopath
End Sub

Private Sub Text2_Change()

End Sub

Private Sub Timer1_Timer()
      clearreturn = WaitRS(com1, vbCrLf, 20)
  com1.Output = "RD" & Space(1) & "1800" & vbCr
      clearreturn = WaitRS(com1, vbCrLf, 40)
     If Val(clearreturn) = 1 Then
            S4 = True: Exit Sub
          Else
            If S4 = True Then
             S3 = True
            End If
       End If
       
   If S3 Then
            S3 = False: S4 = False
            readdata Tenstsam(1), Tenstsam(2), Tenstsam(3), Tenstsam(4), Tenstsam(5)
    End If
'============================================================
    clearreturn = WaitRS(com1, vbCrLf, 20)
  com1.Output = "RD" & Space(1) & "1200" & vbCr
      clearreturn = WaitRS(com1, vbCrLf, 40)
     If Val(clearreturn) = 1 Then
            ss4 = True: Exit Sub
          Else
            If ss4 = True Then
             ss3 = True
            End If
       End If
       If ss3 Then
              ss3 = False: ss4 = False ': F1Book1.Enabled = False
                                  '==============='急停
                        clearreturn = WaitRS(com1, vbCrLf, 20)
                        com1.Output = "RD" & Space(1) & "dm400" & vbCr
                        If Not Val(WaitRS(com1, vbCrLf, 20)) = 1 Then
                        '    F1Book1.Enabled = True
                            Exit Sub
                        End If
                      '=========================
                    clearreturn = WaitRS(com1, vbCrLf, 10)
                   com1.Output = "RD" & Space(1) & "DM204" & vbCr
                      ronghang = Val(WaitRS(com1, vbCrLf, 20)) + 1
                      clearreturn = WaitRS(com1, vbCrLf, 10)
                   com1.Output = "RD" & Space(1) & "DM203" & vbCr
                      ronglei = Val(WaitRS(com1, vbCrLf, 20)) + 1
                   If ronghang = 1 And ronglei = 1 Then reprintgraph
                   F1Book1.TextRC(f1row + 1, 1) = "NO" & bianhao & "-" & ronghang & "-" & ronglei
                   F1Book1.TextRC(f1row + 1, 2) = Now
                   f1row = f1row + 1
                    F1Book1.MaxRow = f1row
                    displaydata Tenstsam(1), Tenstsam(2), Tenstsam(3), Tenstsam(4), Tenstsam(5)
                    '判定是否OKng
                   PdOKNg f1row, F1Book1.MaxCol
                   cleardata
                     If ronghang = Val(xtoll.Text) And ronglei = Val(ytoll.Text) Then
                         If autosavedata = 1 Or autosavedata = True Then savetopath
                         bianhao = bianhao + 1
                      End If
                      If zdboolean = True Then
                               If frmmain.F1Book1.NumberRC(f1row, dialig1) > frmmain.F1Book1.NumberRC(2, dialig1) Or frmmain.F1Book1.NumberRC(3, dialig1) Then
                               zhuidu1.ForeColor = vbRed
                               Else
                               zhuidu1.ForeColor = vbbeack
                               End If
                               If frmmain.F1Book1.NumberRC(f1row, dialig2) > frmmain.F1Book1.NumberRC(2, dialig2) Or frmmain.F1Book1.NumberRC(3, dialig2) Then zhuidu1.ForeColor = vbRed
                               frmmain.zhuidu1.Caption = Format(frmmain.F1Book1.NumberRC(f1row, dialig1), "0.0000")
                               frmmain.zhuidu2.Caption = Format(frmmain.F1Book1.NumberRC(f1row, dialig2), "0.0000")
                      End If
                     '   F1Book1.Enabled = True
                   SendKeys "{HOME}" + "{DOWN}"
                 
        End If
End Sub

Private Sub Timer2_Timer()



End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.Index
 Case 1
      mstart_Click
  Case 2
      saveto_Click
 Case 3
    mcontrol_Click
 Case 4
       View.Show 1
 Case 5
       dlgSavePath.Show 1
' Case 6
  '   mprint_Click
 Case 6
      mcom_Click
 Case 7
     mexit_Click
  Case 8
    mhelp_Click
 End Select
End Sub
Private Sub F1Book1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
     frmmain.PopupMenu f1book
 End If
End Sub
Private Sub uu_Click(Index As Integer)
   On Error Resume Next
Select Case Index
   Case 1
   F1Book1.EditCopy
   Case 2
F1Book1.EditPaste
   Case 3
F1Book1.EditCut
   Case 4
 F1Book1.EditClear 1
  Case 6
  msaveas_Click
  Case 7
       Dim msg As String
             msg = MsgBox("您要保存当前的数据吗？", vbYesNoCancel + vbInformation, "提示")
        If msg = vbYes Then
                              msaveas_Click
                               F1Book1.ClearRange 4, 1, 16384, 256, 3
                               f1row = 1
                               oktall = 0: ngtall = 0: bianhao = 1
                               lok.Caption = 0: lng.Caption = 0
                               zhuidu1.Caption = "00.0000"
                               zhuidu2.Caption = "00.0000"
                             F1Book1.MaxRow = 4
           ElseIf msg = vbNo Then
             oktall = 0: ngtall = 0: bianhao = 1
             lok.Caption = 0: lng.Caption = 0
              F1Book1.ClearRange 4, 1, 16384, 256, 3
               f1row = 1
                               zhuidu1.Caption = "00.0000"
                               zhuidu2.Caption = "00.0000"
                         F1Book1.MaxRow = 4

            Else
                 Exit Sub
             End If
         
   End Select
End Sub

Private Sub xtoll_Change()
frmmain.com1.Output = "WR" & Space(1) & "DM" & 9 & Space(1) & Val(xtoll.Text) & vbCr
If Not WaitRS(frmmain.com1, vbCrLf, 40) = "OK" & vbCr & vbLf Then MsgBox "参数写入失败！", vbOKOnly + vbInformation, "提示"

End Sub

Private Sub ytoll_Change()
frmmain.com1.Output = "WR" & Space(1) & "DM" & 8 & Space(1) & Val(ytoll.Text) & vbCr
If Not WaitRS(frmmain.com1, vbCrLf, 40) = "OK" & vbCr & vbLf Then MsgBox "参数写入失败！", vbOKOnly + vbInformation, "提示"
End Sub