module1.bas

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

End If
If Tenstsam(4) = True Then '最小
   For j = 1 To ppoints
      i = i + 1
         frmmain.F1Book1.TextRC(1, i) = "MIN" & j
         If diamoth = 1 Then
         frmmain.F1Book1.NumberRC(2, i) = diaupper(j)
         frmmain.F1Book1.NumberRC(3, i) = dialower(j)
         If zdboolean = True And j = zd1 + 1 Then
         zdgongshi = int_char(Val(i)) & 5 & "-"
         dialig1 = Val(i)
         End If
         If zdboolean = True And j = zd2 + 1 Then
           zdgongshi = "ABS(" & zdgongshi & int_char(Val(i)) & 5 & ")"
           frmmain.F1Book1.FormulaRC(5, 4) = zdgongshi
           dialig2 = Val(i)
           End If
         Else
         frmmain.F1Book1.NumberRC(2, i) = 99
         frmmain.F1Book1.NumberRC(3, i) = 0
        End If
    Next j
End If
If Tenstsam(5) = True Then   '最大
   For j = 1 To ppoints
      i = i + 1
      frmmain.F1Book1.TextRC(1, i) = "MAX" & j
         If diamoth = 2 Then
         frmmain.F1Book1.NumberRC(2, i) = diaupper(j)
         frmmain.F1Book1.NumberRC(3, i) = dialower(j)
         If zdboolean = True And j = zd1 + 1 Then
         zdgongshi = int_char(Val(i)) & 5 & "-"
         dialig1 = Val(i)
         End If
         If zdboolean = True And j = zd2 + 1 Then
           zdgongshi = "ABS(" & zdgongshi & int_char(Val(i)) & 5 & ")"
           frmmain.F1Book1.FormulaRC(5, 4) = zdgongshi
           dialig2 = Val(i)
           End If
         Else
         frmmain.F1Book1.NumberRC(2, i) = 99
         frmmain.F1Book1.NumberRC(3, i) = 0
         End If
       Next j
End If
frmmain.F1Book1.MaxCol = i
mainmaxcol = i
End Function
Function readdata(ByVal b1 As Boolean, ByVal b2 As Boolean, ByVal b3 As Boolean, ByVal b4 As Boolean, ByVal b5 As Boolean)
'If b1 = True Then
 '        frmmain.com1.Output = "RDS" & Space(1) & "DM40" & Space(1) & cntpoints & vbCr
 '        datastring1 = WaitRS(frmmain.com1, vbCrLf, 50)
'End If
If b2 = True Then
         frmmain.com1.Output = "RDS" & Space(1) & "DM40" & Space(1) & cntpoints & vbCr
          datastring2 = WaitRS(frmmain.com1, vbCrLf, 50)
End If
If b3 = True Then
         frmmain.com1.Output = "RDS" & Space(1) & "DM30" & Space(1) & cntpoints & vbCr
         datastring3 = WaitRS(frmmain.com1, vbCrLf, 50)
End If
If b4 = True Or b1 = True Then
         frmmain.com1.Output = "RDS" & Space(1) & "DM120" & Space(1) & cntpoints & vbCr
         datastring4 = WaitRS(frmmain.com1, vbCrLf, 50)
End If
If b5 = True Or b1 = True Then
         frmmain.com1.Output = "RDS" & Space(1) & "DM20" & Space(1) & cntpoints & vbCr
         datastring5 = WaitRS(frmmain.com1, vbCrLf, 50)
End If
End Function
Function displaydata(ByVal b1 As Boolean, ByVal b2 As Boolean, ByVal b3 As Boolean, ByVal b4 As Boolean, ByVal b5 As Boolean)
If zdboolean = True Then
   f1col = 4
        frmmain.F1Book1.SelStartCol = 4
        frmmain.F1Book1.SelEndCol = 4
        frmmain.F1Book1.SelStartRow = 5
        frmmain.F1Book1.SelEndRow = 5
        frmmain.F1Book1.EditCopy
        frmmain.F1Book1.SelStartCol = 4
        frmmain.F1Book1.SelEndCol = 4
        frmmain.F1Book1.SelStartRow = f1row
        frmmain.F1Book1.SelEndRow = f1row
        frmmain.F1Book1.EditPaste
Else
f1col = 3
End If
'=====================
If b2 = True Then
        f1bookdata datastring2
End If
If b3 = True Then
       f1bookdata datastring3
End If
'******************
If b1 = True Then
        f1bookdataave datastring4, datastring5
End If

If b4 = True Then
       f1bookdata datastring4
End If
If b5 = True Then
        f1bookdata datastring5
End If

End Function
Function f1bookdata(ByVal instr1 As String)
Dim ha1 As Integer
Dim hh As Integer
If Mid(instr1, 2, 1) = vbCr Then instr1 = Mid(instr1, 3, cntpoints * 6) & vbCr
               Do
                hh = hh + 1
                f1col = f1col + 1
                frmmain.F1Book1.NumberRC(f1row, f1col) = Val(Mid(instr1, ha1 + 1, 6)) / 10000
                ha1 = ha1 + 6
      Loop Until hh >= cntpoints
End Function
Function f1bookdataave(ByVal instrmin As String, ByVal instrmax As String)
Dim ha1 As Integer
Dim hh As Integer
If Mid(instrmin, 2, 1) = vbCr Then instrmin = Mid(instrmin, 3, cntpoints * 6) & vbCr
If Mid(instrmax, 2, 1) = vbCr Then instrmax = Mid(instrmax, 3, cntpoints * 6) & vbCr
               Do
                hh = hh + 1
                f1col = f1col + 1
                frmmain.F1Book1.NumberRC(f1row, f1col) = (Val(Mid(instrmax, ha1 + 1, 6)) + Val(Mid(instrmin, ha1 + 1, 6))) / 20000
                ha1 = ha1 + 6
      Loop Until hh >= cntpoints
End Function
Function zdnoenble()
fsetcontrol.Combo3.Enabled = False
fsetcontrol.Combo4.Enabled = False
fsetcontrol.zdlower.Enabled = False
fsetcontrol.zdupper.Enabled = False
End Function
Function zdenble()
fsetcontrol.Combo3.Enabled = True
fsetcontrol.Combo4.Enabled = True
fsetcontrol.zdlower.Enabled = True
fsetcontrol.zdupper.Enabled = True
End Function

'//返回测定的方法
Function displaytenstmoth(ByVal ininteger As Integer)
If ininteger >= 32 Then
   fsetcontrol.Check6 = 1
   ininteger = ininteger - 32
   Else
    fsetcontrol.Check6 = 0
 End If

If ininteger >= 16 Then
   fsetcontrol.Check1 = 1
   ininteger = ininteger - 16
   fsetcontrol.Combo2.ListIndex = 0
   Else
   fsetcontrol.Check1 = 0
 End If

If ininteger >= 8 Then
   fsetcontrol.Check2 = 1
   ininteger = ininteger - 8
   Else
    fsetcontrol.Check2 = 0
 End If
 
 If ininteger >= 4 Then
   fsetcontrol.Check3 = 1
   ininteger = ininteger - 4
   Else
    fsetcontrol.Check3 = 0
 End If
 
 If ininteger >= 2 Then
   fsetcontrol.Check4 = 1
   ininteger = ininteger - 2
   fsetcontrol.Combo2.ListIndex = 1
   Else
   fsetcontrol.Check4 = 0
 End If
 
 If ininteger >= 1 Then
   fsetcontrol.Check5 = 1
   ininteger = ininteger - 1
    fsetcontrol.Combo2.ListIndex = 2
   Else
   fsetcontrol.Check5 = 0
 End If
End Function

Function PdOKNg(ByVal bookrow As Integer, ByVal bookcol As Integer)
Dim i As Integer
frmmain.F1Book1.SelStartRow = bookrow
frmmain.F1Book1.SelEndRow = bookrow

For i = 4 To frmmain.F1Book1.MaxCol
          frmmain.F1Book1.SelStartCol = i
          frmmain.F1Book1.SelEndCol = i
   If frmmain.F1Book1.NumberRC(bookrow, i) > frmmain.F1Book1.NumberRC(2, i) Or frmmain.F1Book1.NumberRC(bookrow, i) < frmmain.F1Book1.NumberRC(3, i) Then
           frmmain.F1Book1.SetFont "宋体", 10, False, False, False, False, vbRed, False, False
           ' If Not i = 4 Then okngboolean = True
             okngboolean = True
          Else
           frmmain.F1Book1.SetFont "宋体", 10, False, False, False, False, &H80000008, False, False
          
   End If
 Next i
 
 If okngboolean = True Then
           frmmain.pic1ng.Visible = True
           frmmain.pic1OK.Visible = False
          initng ronghang, ronglei
          ngtall = ngtall + 1
          frmmain.lng.Caption = ngtall
          frmmain.F1Book1.TextRC(bookrow, 3) = pdyuyanng
          frmmain.F1Book1.SelStartCol = 3
          frmmain.F1Book1.SelEndCol = 3
          frmmain.F1Book1.SetFont "宋体", 10, True, False, False, False, vbRed, False, False
    Else
           frmmain.pic1ng.Visible = False
           frmmain.pic1OK.Visible = True
           initok ronghang, ronglei
           oktall = oktall + 1
           frmmain.lok.Caption = oktall
           frmmain.F1Book1.TextRC(bookrow, 3) = pdyuyanok
           frmmain.F1Book1.SelStartCol = 3
           frmmain.F1Book1.SelEndCol = 3
           frmmain.F1Book1.SetFont "宋体", 10, True, False, False, False, vbGreen, False, False
     End If

      okngboolean = False
End Function
Function clickPdOKNg(ByVal bookrow As Integer, ByVal bookcol As Integer)
Dim i As Integer
frmmain.F1Book1.SelStartRow = bookrow
frmmain.F1Book1.SelEndRow = bookrow
For i = 4 To frmmain.F1Book1.MaxCol
          frmmain.F1Book1.SelStartCol = i
          frmmain.F1Book1.SelEndCol = i
   If frmmain.F1Book1.NumberRC(bookrow, i) > frmmain.F1Book1.NumberRC(2, i) Or frmmain.F1Book1.NumberRC(bookrow, i) < frmmain.F1Book1.NumberRC(3, i) Then
           frmmain.F1Book1.SetFont "宋体", 10, False, False, False, False, vbRed, False, False
            'If Not i = 4 Then okngboolean = True
            okngboolean = True
          Else
           frmmain.F1Book1.SetFont "宋体", 10, False, False, False, False, &H80000008, False, False
          
   End If
 Next i
 
 If okngboolean = True Then
           frmmain.pic1ng.Visible = True
           frmmain.pic1OK.Visible = False
          initng readnohang(frmmain.F1Book1.TextRC(bookrow, 1)), readnolei(frmmain.F1Book1.TextRC(bookrow, 1))
          frmmain.F1Book1.TextRC(bookrow, 3) = pdyuyanng
          frmmain.F1Book1.SelStartCol = 3
          frmmain.F1Book1.SelEndCol = 3
          frmmain.F1Book1.SetFont "宋体", 10, True, False, False, False, vbRed, False, False
    Else
           frmmain.pic1ng.Visible = False
           frmmain.pic1OK.Visible = True
           initok readnohang(frmmain.F1Book1.TextRC(bookrow, 1)), readnolei(frmmain.F1Book1.TextRC(bookrow, 1))
           frmmain.F1Book1.TextRC(bookrow, 3) = pdyuyanok
           frmmain.F1Book1.SelStartCol = 3
           frmmain.F1Book1.SelEndCol = 3
           frmmain.F1Book1.SetFont "宋体", 10, True, False, False, False, vbGreen, False, False
     End If

      okngboolean = False
End Function
Function readnohang(ByVal stringno As String) As Integer
Dim i, j As Integer
i = InStr(2, stringno, "-")
j = InStr(i + 1, stringno, "-")
readnohang = Val(Mid(stringno, i + 1, j - i - 1))
End Function
Function readnolei(ByVal stringno As String) As Integer
Dim i, j As Integer
i = InStr(2, stringno, "-")
j = InStr(i + 1, stringno, "-")
readnolei = Val(Mid(stringno, j + 1))
End Function
Function cleardata()
datastring1 = "": datastring2 = "": datastring3 = "": datastring4 = "": datastring5 = ""
End Function
Function reprintgraph()
frmmain.graph.Cls
inigraph 25, 20 '初始化料盘
End Function

'**************************************
'在电子表格中数字列到字母列的转变函数
'right for slan
Function int_char(a As Integer) As String
Dim i As Integer
Dim sam As String
While (a > 26)
   If Not a Mod 26 = 0 Then
  sam = sam & Chr(a Mod 26 + 64)
  Else
  sam = sam & Chr(26 + 64)
  a = a - 1
  End If
  a = Int(a / 26)
  Wend
  sam = sam & Chr(a + 64)
  For i = Len(sam) To 1 Step -1
     int_char = int_char & Mid(sam, i, 1)
     Next
End Function
Function dianjistart()
frmmain.Timer1.Enabled = Not frmmain.Timer1.Enabled
 If frmmain.Timer1.Enabled = True Then
       frmmain.Toolbar1.Buttons(1).Caption = "停止监视"
        frmmain.mstart.Caption = "停止监视"
       frmmain.Sta1.Panels(1).Text = "正在监视数据........."
       Else
       frmmain.Toolbar1.Buttons(1).Caption = "开始监视"
       frmmain.mstart.Caption = "开始监视"
       frmmain.Sta1.Panels(1).Text = "等待开始监视。。。。。"
      ' Command3.SetFocus
    End If
End Function