Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'聲明調(diào)用的GetTickCount函數(shù)和Sleep函數(shù)
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public f1row, f1col As Integer 'F1book1的行數(shù)。
Public mingzi As String         '以月日小時(shí)分鐘為名保存文件
Public S3, S4, ss3, ss4 As Boolean '總的判定
Public ngtall, oktall As Integer '總的NG
Public Tenstsam(1 To 5) As Boolean '測(cè)量的方法！
Public cntpoints As Integer '///設(shè)置測(cè)量點(diǎn)的數(shù)量
Public diaupper(1 To 8), dialower(1 To 8), zyupper(1 To 8), txupper(1 To 8) As Single
Public ronghang, ronglei As Integer  '行列
Public okngboolean As Integer      '總的OKNG
Public Const mdbj As Integer = 53 / 69 * 100 '馬達(dá)的轉(zhuǎn)換
Public zdboolean As Boolean '//是否顯示錐度
Public Bzdupper, Bzdlower As Single '錐度的上下限
Public zd1, zd2 As Integer
Public zdgongshi As String
Public datastring1, datastring2, datastring3, datastring4, datastring5 As String '//數(shù)據(jù)反村
Public pdyuyanok, pdyuyanng, datasavepath As String   '為程序參數(shù)
Public autosavedata, closesavedata, zhuijiaboolean As Boolean
Public f1bookdatatype As Integer
Public dialig1, dialig2 As Integer '為液晶字的列數(shù)
Public bianhao As Integer '為總的編號(hào)
Public mainmaxcol As Integer '為總的列數(shù)
Public jiankongboolean As Boolean '為是否自動(dòng)開啟

'Public emputydata, emputydata1 As Integer '為空的數(shù)據(jù)
'處理從COM口中得到的數(shù)據(jù)，并進(jìn)行處理返回一個(gè)比較規(guī)范的字符
Function WaitRS(Com As MSComm, rs As String, DT As Integer) As String
    Dim buf$, TT As Long
     buf = ""
    TT = GetTickCount
    Do
         DoEvents
        buf = buf & Com.Input
    Loop Until InStr(1, buf, rs) > 0 Or GetTickCount - TT > DT
    If InStr(1, buf, rs) > 0 Then
         WaitRS = Trim(buf)
    Else
        WaitRS = ""
     End If

End Function
Function addtime(DT As Long)
  Dim TT As Long
  TT = GetTickCount()
  Do
    DoEvents
    If GetTickCount - TT < 0 Then TT = GetTickCount
  Loop Until GetTickCount - TT >= DT
End Function


Function backtored(ByVal row As Integer, ByVal col As Integer, ByVal fsize As Integer)
                            frmmain.F1Book1.SelStartCol = col
                            frmmain.F1Book1.SelEndCol = col
                            frmmain.F1Book1.SelEndRow = row
                            frmmain.F1Book1.SelStartRow = row
                            frmmain.F1Book1.SetFont "宋體", fsize, False, False, False, False, vbRed, False, False
End Function
Function backtogreen(ByVal row As Integer, ByVal col As Integer, ByVal fsize As Integer)
                            frmmain.F1Book1.SelStartCol = col
                            frmmain.F1Book1.SelEndCol = col
                            frmmain.F1Book1.SelEndRow = row
                            frmmain.F1Book1.SelStartRow = row
                            frmmain.F1Book1.SetFont "宋體", fsize, True, False, False, False, vbGreen, False, False

End Function
Function backfont(ByVal row As Integer, ByVal col As Integer, ByVal fsize As Integer)
                            frmmain.F1Book1.SelStartCol = col
                            frmmain.F1Book1.SelEndCol = col
                            frmmain.F1Book1.SelEndRow = row
                            frmmain.F1Book1.SelStartRow = row
                            frmmain.F1Book1.SetFont "宋體", fsize, True, False, False, False, &H0&, False, False
End Function
Function backfont1(ByVal row As Integer, ByVal col As Integer, ByVal fsize As Integer)
                            frmmain.F1Book1.SelStartCol = col
                            frmmain.F1Book1.SelEndCol = col
                            frmmain.F1Book1.SelEndRow = row
                            frmmain.F1Book1.SelStartRow = row
                            frmmain.F1Book1.SetFont "宋體", fsize, False, False, False, False, &H0&, False, False
End Function
'求反正切
Function pyramidal(ByVal diameter1 As Single, ByVal diameter2 As Single, ByVal distance As Single)
'pyramidal = Atn(Abs(diameter2 - diameter1) / 2 / distance) * 180 / 3.1415927
pyramidal = Abs(diameter2 - diameter1)
End Function
Function savetopath() As String
Dim sam As String
On Error Resume Next
        If zhuijiaboolean = False Then mingzi = getname
             If mingzi = "" Then Exit Function
      Select Case f1bookdatatype
      Case 2
      frmmain.F1Book1.Write datasavepath & "\" & mingzi & ".htm", 10
      Case 1
       frmmain.F1Book1.Write datasavepath & "\" & mingzi & ".txt", 6
        Case Else
       frmmain.F1Book1.Write datasavepath & "\" & mingzi & ".xls", 11
       End Select
     sam = Dir(datasavepath & "\" & mingzi, vbDirectory)
     If sam = "" Then MkDir datasavepath & "\" & mingzi
    SavePicture frmmain.graph.Image, datasavepath & "\" & mingzi & "\" & frmmain.dname.Text & "(" & bianhao & ")" & ".bmp"
End Function
Function getname() As String
 Dim h1 As Integer, h2 As Integer
     Dim m1 As Integer, m2 As Integer
     Dim t1, t2 As Variant
    t1 = Format(Time, "h:mm:ss")
     h1 = Val(Hour(t1)): m1 = Val(Minute(t1))
    t2 = Format(Date, "Long Date")
      h2 = Val(Month(t2)): m2 = Val(Day(t2))
    getname = h2 & "-" & m2 & "-" & h1 & "-" & m1 & "--" & frmmain.dname.Text & "(" & bianhao & ")"
End Function
Function setnoenable()
'frmmain.mstart.Enabled = False
frmmain.mview.Enabled = False
frmmain.mout.Enabled = False
frmmain.saveto.Enabled = False
frmmain.Toolbar1.Buttons(2).Enabled = False
frmmain.Toolbar1.Buttons(3).Enabled = False
frmmain.Toolbar1.Buttons(4).Enabled = False
frmmain.Toolbar1.Buttons(5).Enabled = False
frmmain.Toolbar1.Buttons(6).Enabled = False
frmmain.Toolbar1.Buttons(7).Enabled = False
frmmain.Toolbar1.Buttons(8).Enabled = False
'frmmain.CoolBar1.Enabled = False
'frmmain.DataCombo1.Enabled = False
'frmmain.F1Book1.Enabled = False
End Function
Function inigraph(ByVal countx As Integer, ByVal county As Integer)
Dim i, j As Integer
Dim CX, CY, Radius, Limit   ' Declare variable.
With frmmain.graph
   .Cls
   .ScaleMode = 3   ' 以像素為單位。
   .FillStyle = 0
   .FillColor = RGB(255, 255, 255)
   CX = .ScaleWidth / (countx + 1) ' X 位置。
   CY = .ScaleHeight / (county + 1) ' Y 位置。
'Picture1.Circle (CX, CY), 59, RGB(255, 0, 0)  '紅
'Picture1.Circle (CX, CY), 59, RGB(0, 0, 255) '藍(lán)
If CX > CY Then
For j = 1 To 25
 For i = 1 To 20
    frmmain.graph.Circle (j * CX - CY / 2, i * CY - CY / 2), CY / 2, RGB(255, 255, 255)
    Next i
    Next j
Else
For j = 1 To 25
 For i = 1 To 20
     frmmain.graph.Circle (j * CX - CX / 2, i * CY - CX / 2), CX / 2, RGB(255, 255, 255)
    Next i
    Next j
End If
End With
    
End Function
Function initok(ByVal numberokhang As Integer, ByVal numberoklei As Integer)
Dim row, col As Integer
row = numberokhang
col = numberoklei
If col = 0 Then
    row = row - 1
    col = 20
    End If
Dim i, j As Integer
Dim CX, CY, Radius, Limit   ' Declare variable.
With frmmain.graph
   .ScaleMode = 3   ' 以像素為單位。
   .FillStyle = 0
   .FillColor = RGB(0, 255, 0)
   CX = .ScaleWidth / (25 + 1) ' X 位置。
   CY = .ScaleHeight / (20 + 1) ' Y 位置。
'frmmain.graph.Circle (CX, CY), 59, RGB(255, 0, 0)  '紅
'frmmain.graph.Circle (CX, CY), 59, RGB(0, 0, 255) '藍(lán)
If CX > CY Then
     frmmain.graph.Circle (row * CX - CY / 2, col * CY - CY / 2), CY / 2, RGB(0, 255, 0)
Else
     frmmain.graph.Circle (row * CX - CX / 2, col * CY - CX / 2), CX / 2, RGB(0, 255, 0)
End If
End With
End Function
Function initng(ByVal numbernghang As Integer, ByVal numbernglei As Integer)
Dim row, col As Integer
row = numbernghang
col = numbernglei
If col = 0 Then
    row = row - 1
    col = 20
    End If
Dim i, j As Integer
Dim CX, CY, Radius, Limit   ' Declare variable.
With frmmain.graph
   .ScaleMode = 3   ' 以像素為單位。
   .FillStyle = 0
   .FillColor = RGB(255, 0, 0)
   CX = .ScaleWidth / (25 + 1) ' X 位置。
   CY = .ScaleHeight / (20 + 1) ' Y 位置。
'frmmain.graph.Circle (CX, CY), 59, RGB(255, 0, 0)  '紅
'frmmain.graph.Circle (CX, CY), 59, RGB(0, 0, 255) '藍(lán)
If CX > CY Then
     frmmain.graph.Circle (row * CX - CY / 2, col * CY - CY / 2), CY / 2, RGB(255, 0, 0)
Else
     frmmain.graph.Circle (row * CX - CX / 2, col * CY - CX / 2), CX / 2, RGB(255, 0, 0)
End If
End With
End Function

Function tenstmoth(ByVal avexd As Integer, ByVal avezj As Integer, ByVal tx As Integer, ByVal zy As Integer, ByVal minzj As Integer, ByVal maxzj As Integer) As Integer
tenstmoth = avexd * 32 + avezj * 16 + tx * 8 + zy * 4 + minzj * 2 + maxzj
End Function
Function clearpoints(cnt As Integer)
Dim clearstring, errstring As String
clearstring = WaitRS(frmmain.com1, vbCrLf, 40)
frmmain.com1.Output = "WR" & Space(1) & "DM" & 50 + cnt & Space(1) & 0 & vbCr
clearstring = WaitRS(frmmain.com1, vbCrLf, 40)
 If Not clearstring = "OK" & vbCr & vbLf Then errstring = errstring & ",成品半成品"
End Function
Function clearpointsALL()
frmmain.com1.Output = "WRS" & Space(1) & "DM" & 50 & Space(1) & 8 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & vbCr
addtime (100)
frmmain.com1.Output = "WRS" & Space(1) & "DM" & 60 & Space(1) & 8 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & vbCr
addtime (100)
frmmain.com1.Output = "WRS" & Space(1) & "DM" & 70 & Space(1) & 8 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & vbCr
addtime (100)
frmmain.com1.Output = "WRS" & Space(1) & "DM" & 80 & Space(1) & 8 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & vbCr
addtime (100)
frmmain.com1.Output = "WRS" & Space(1) & "DM" & 90 & Space(1) & 8 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & vbCr
addtime (100)
frmmain.com1.Output = "WRS" & Space(1) & "DM" & 100 & Space(1) & 8 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & vbCr
addtime (100)
frmmain.com1.Output = "WRS" & Space(1) & "DM" & 110 & Space(1) & 8 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & Space(1) & 0 & vbCr
End Function
Function displaybiaotu(ByVal ininteger As Integer, ByVal ppoints As Integer, ByVal diamoth As Integer)
Dim i As Integer, j As Integer
If ininteger >= 32 Then
   zdboolean = True
   ininteger = ininteger - 32
 End If

If ininteger >= 16 Then
   Tenstsam(1) = True
   ininteger = ininteger - 16
   Else
   Tenstsam(1) = False
 End If

If ininteger >= 8 Then
    Tenstsam(2) = True
   ininteger = ininteger - 8
   Else
   Tenstsam(2) = False
 End If
 
 If ininteger >= 4 Then
    Tenstsam(3) = True
   ininteger = ininteger - 4
    Else
   Tenstsam(3) = False
 End If
 
 If ininteger >= 2 Then
    Tenstsam(4) = True
   ininteger = ininteger - 2
      Else
   Tenstsam(4) = False
 End If
 
 If ininteger >= 1 Then
    Tenstsam(5) = True
   ininteger = ininteger - 1
      Else
   Tenstsam(5) = False
 End If

If zdboolean = True Then
i = 4
frmmain.F1Book1.TextRC(1, 4) = "斜度"
frmmain.F1Book1.NumberRC(2, 4) = Bzdupper
frmmain.F1Book1.NumberRC(3, 4) = Bzdlower
Else
i = 3
End If

If Tenstsam(2) = True Then '同心
   For j = 1 To ppoints
   i = i + 1
   frmmain.F1Book1.TextRC(1, i) = "C" & j
   frmmain.F1Book1.NumberRC(2, i) = txupper(j)
   frmmain.F1Book1.NumberRC(3, i) = 0
  Next j
End If
If Tenstsam(3) = True Then '真圓
   For j = 1 To ppoints
        i = i + 1
        frmmain.F1Book1.TextRC(1, i) = "R" & j
        frmmain.F1Book1.NumberRC(2, i) = zyupper(j)
        frmmain.F1Book1.NumberRC(3, i) = 0
     Next j
End If

If Tenstsam(1) = True Then '平均
   For j = 1 To ppoints
      i = i + 1
      frmmain.F1Book1.TextRC(1, i) = "AVR" & j
      If diamoth = 0 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