mditest.frm

这个程序包的主要功能是对多台5101b进行功能化测试

          send_order "FUNC DCV,100", 0
       Else
          send_order "FUNC DCV,1000", 0
       End If
       initialize
       wait 1
       send_order "0" & t, 11
       If p = 1 Or p = 2 Or p = 3 Or p = 5 Or p = 6 Or p = 8 Or p = 9 Or p = 11 Or p = 12 Or p = 14 Or p = 15 Or p = 17 Then
          send_order "0V,N", t
          wait 8
          send_order "MATH NULL", 0
          initialize
       End If
       wait 3
       send_order "C", t
       If q = 1 Then
          order = "+" & msdcv(p) & "V,N"
       Else
          order = "-" & msdcv(p) & "V,N"
       End If
       send_order order, t
       wait 12
       initialize
       If q = 1 Then
          receive_data msdcvTP(t, p), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msdcvTP(t, p), 16) & "V"
       Else
          receive_data msdcvTP(t, p + 19), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msdcvTP(t, p + 19), 16) & "V"
       End If
       initialize
       send_order "C", t
       send_order "0V,N", t
       initialize
       wait 1
       If keyflag = 1 Then
          picstatue.Cls
          picstatue.Print "中断程序运行!"
          keyflag = 0
          send_order "*", t
          send_order "RESET", 0
          Exit Sub
       End If
     Next t
   Next p
   Next q
   For t = 1 To Number
   send_order "*", t
   send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
       
   picstatue.Cls
   picstatue.Print "测试完毕！"
   
   Saveflag = 1
0
   mdifomtest.mnusave.Enabled = True
   mdifomtest.imgsave1.Enabled = True
   mdifomtest.imgsave2.Enabled = True
   
   mnumsacvL_Click

End Sub



Private Sub mnumsinpadds_Click()
   fominpadds.Show

End Sub

Private Sub mnumsohm_Click()
   Dim p, t As Integer
   Dim Response As Integer
       
   Response = MsgBox("请做好四线电阻测试连接!", vbOKCancel + vbInformation + vbDefaultButton1, "Ohm Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
   
   picstatue.Cls
   picstatue.Print "现在进行OHM的功能测试！(按Shift + F2键可中断程序运行)"
   
   fomcheck.Show
   fomcheck.Caption = "Test"

   'msr = Array(1, 10, 100, 1000, 10000, 100000, 1000000, 10000000)
   
   initialize                      'test interface IEEE488
   receive_data temp, 0
   If IEEnoteflag = vbOK Then
      Exit Sub
   End If
   
   initialize
   For t = 1 To Number
   initialize
   send_order "*", t
   send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11

   For t = 1 To Number
   initialize
   send_order "C", t
   send_order "1ZX1,N", t   '防止开始设置量程时 显示过载
   Next t

   initialize
   fomcheck.lstchdata.AddItem "Test OHM:"
   '------------------OHM--------------
   For p = 1 To 8
     initialize
     send_order "01", 11
     Select Case p
     Case 1 To 2
        send_order "FUNC OHMF,10;OCOMP ON;DELAY 1;NPLC 100", 0
     Case 3
        send_order "FUNC OHMF,100;OCOMP ON;DELAY 1;NPLC 100", 0
     Case 4
        send_order "FUNC OHMF,1E3;OCOMP ON;DELAY 1;NPLC 100", 0
     Case 5
        send_order "FUNC OHMF,1E4;OCOMP ON;DELAY 1;NPLC 100", 0
     Case 6
        send_order "FUNC OHMF,1E5;OCOMP ON;DELAY 1;NPLC 100", 0
     Case 7
        send_order "FUNC OHMF,1E6;OCOMP ON;DELAY 1;NPLC 100", 0
     Case 8
        send_order "FUNC OHMF,1E7;OCOMP ON;DELAY 1;NPLC 100", 0
     End Select
     initialize
     wait 1
     For t = 1 To Number
        order = msr(p) & "ZX1,N"
        send_order "0" & t, 11
        initialize
        send_order "C", t
        send_order order, t
        wait 60
        receive_data msrTP(t, p), 0
        fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msrTP(t, p), 16) & "ohm"
        initialize
        wait 1
        initialize
        send_order "MEM LIFO", 0
        initialize
     Next t
     wait 1
    
     If keyflag = 1 Then
        picstatue.Cls
        picstatue.Print "中断程序运行!"
        keyflag = 0
        Exit Sub
        send_order "*", t
        send_order "RESET", 0
     End If
   Next p
   For t = 1 To Number
      initialize
      send_order "*", t
      send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
  
   picstatue.Cls
   picstatue.Print "测试完毕！"
   
   Saveflag = 1
   
   mdifomtest.mnusave.Enabled = True
   mdifomtest.imgsave1.Enabled = True
   mdifomtest.imgsave2.Enabled = True

   mnumsdci_Click

End Sub


Private Sub mnuopen_Click()
On Error GoTo Errorhandler
   cmndilgopen.Filter = "Excel Files(*.xls)|*.xls|Word Files(*.doc)|*.doc| "
   cmndilgopen.FilterIndex = 1
   cmndilgopen.ShowOpen
   
   picstatue.Cls
   picstatue.Print "正在打开文件，请等待！"
   
   Set xl = CreateObject("excel.application")
   Set xlwb = xl.Workbooks.Open(cmndilgopen.filename)
   xl.Visible = True

   picstatue.Cls
   picstatue.Print "欢迎使用AutoTest测试软件！"

Errorhandler:
   Exit Sub

End Sub


Private Sub mnuoutspec_Click()
   fomerror.Show
End Sub

Private Sub mnupaste_Click()
If TypeOf Screen.ActiveControl Is ListBox Then
   Screen.ActiveControl.AddItem Clipboard.GetText()
ElseIf TypeOf Screen.ActiveControl Is TextBox Then
   Screen.ActiveControl.SelText = Clipboard.GetText()
End If

End Sub

Private Sub mnuquit_Click()
   Dim Response As Integer
   Dim msg As String
   
   If Saveflag = 1 Then
      msg = "您未保存数据文件，是否退出？"
   Else
      msg = "您真的要退出该测试程序吗？"
   End If
   
   Response = MsgBox(msg, vbOKCancel + vbQuestion + vbDefaultButton2, "Quit")
   If Response = vbOK Then
       Unload fomcheck
       Unload mdifomtest
   End If

End Sub


Private Sub mnusave_Click()
   Dim i, j, t As Integer
   Dim dcvnullflag, dcinullflag, acinullflag, ohmnullflag, acvnullflag, acvHnullflag As Integer
   
For t = 1 To Number
    
   For i = 1 To 38
       If msdcvTP(t, i) = "" Then
          dcvnullflag = 1
          Exit For
       End If
   Next i
   
   For i = 1 To 14
       If msdciTP(t, i) = "" Then
          dcinullflag = 1
          Exit For
       End If
   Next i
   
   For i = 1 To 8
       If msrTP(t, i) = "" Then
          ohmnullflag = 1
          Exit For
       End If
   Next i

   For i = 1 To 50
       If msacvTP(t, i) = "" Then
          acvnullflag = 1
          Exit For
       End If
   Next i

   For i = 1 To 9
       If msacv51(t, i) = "" Or msacv57(i) = "" Then
          acvHnullflag = 1
          Exit For
       End If
   Next i
   
   For i = 1 To 14
       If msaci51(t, i) = "" Or msaci57(i) = "" Then
          acinullflag = 1
          Exit For
       End If
   Next i
   
Next t

   If acvHnullflag <> 1 Then
      For t = 1 To Number
        For i = 0 To 2
        For j = 1 To 3
            msacvHTP(t, i * 3 + j) = msacvH(j) + msacv51(t, i * 3 + j) - msacv57(i * 3 + j)
        Next j
        Next i
      Next t
   End If

   If acinullflag <> 1 Then
      For t = 1 To Number
        For i = 0 To 2
        For j = 1 To 14
            msaciTP(t, i * 14 + j) = msaci(j) + msaci51(t, i * 14 + j) - msaci57(i * 14 + j)
        Next j
        Next i
      Next t
   End If


On Error GoTo Errorhandler
   cmndilgsave.Filter = "Excel Files(*.xls)|*.xls|Word Files(*.doc)|*.doc| "
   cmndilgsave.FilterIndex = 1
   
   Set xl = CreateObject("excel.application")
   Set xlwb = xl.Workbooks.Open("c:\printd\5101B.xls")
   xl.Visible = False
   
 For t = 1 To Number
   cmndilgsave.ShowSave
   picstatue.Cls
   picstatue.Print "正在保存第" & t & "台被检仪器测试数据，请等待！"
   
   'save dcv measure data
   If dcvnullflag <> 1 Then
   For i = 1 To 4
       If Abs(CSng(Trim(msdcvTP(t, i)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(1) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(1) * 0.001 / 100 - 5 / 1000000 Then
              msdcvTP(t, i) = msdcvTP(t, i) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "*" & Format(msdcvTP(t, i), "#0.###0")
              msdcvTP(t, i) = msdcvTP(t, i) / 1000
       Else
              msdcvTP(t, i) = msdcvTP(t, i) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "'" & Format(msdcvTP(t, i), "#0.###0")
              msdcvTP(t, i) = msdcvTP(t, i) / 1000
       End If
   Next i
   For i = 5 To 7
       If Abs(CSng(Trim(msdcvTP(t, i)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(2) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(2) * 0.001 / 100 - 5 / 1000000 Then
              msdcvTP(t, i) = msdcvTP(t, i) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "*" & Format(msdcvTP(t, i), "##0.##0")
              msdcvTP(t, i) = msdcvTP(t, i) / 1000
       Else
              msdcvTP(t, i) = msdcvTP(t, i) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "'" & Format(msdcvTP(t, i), "##0.##0")
              msdcvTP(t, i) = msdcvTP(t, i) / 1000
       End If
   Next i
   For i = 8 To 10
       If Abs(CSng(Trim(msdcvTP(t, i)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(3) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(3) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "*" & Format(msdcvTP(t, i), "0.####0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "'" & Format(msdcvTP(t, i), "0.####0")
       End If
   Next i
   For i = 11 To 13
       If Abs(CSng(Trim(msdcvTP(t, i)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(4) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(4) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "*" & Format(msdcvTP(t, i), "#0.###0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "'" & Format(msdcvTP(t, i), "#0.###0")
       End If
   Next i
   For i = 14 To 16
       If Abs(CSng(Trim(msdcvTP(t, i)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(5) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(5) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "*" & Format(msdcvTP(t, i), "##0.##0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "'" & Format(msdcvTP(t, i), "##0.###0")
       End If
   Next i
   For i = 17 To 19
       If Abs(CSng(Trim(msdcvTP(t, i)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(6) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(6) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "*" & Format(msdcvTP(t, i), "###0.#0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 4).Value = "'" & Format(msdcvTP(t, i), "###0.#0")
       End If
   Next i

   For i = 1 To 4
       If Abs(CSng(Trim(msdcvTP(t, i + 19)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(1) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i + 19)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(1) * 0.001 / 100 - 5 / 1000000 Then
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "*" & Format(msdcvTP(t, i + 19), "##0.###0")
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) / 1000
       Else
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "'" & Format(msdcvTP(t, i + 19), "##0.###0")
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) / 1000
       End If
   Next i
   For i = 5 To 7
       If Abs(CSng(Trim(msdcvTP(t, i + 19)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(2) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i + 19)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(2) * 0.001 / 100 - 5 / 1000000 Then
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "*" & Format(msdcvTP(t, i + 19), "###0.##0")
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) / 1000
       Else
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) * 1000
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "'" & Format(msdcvTP(t, i + 19), "###0.##0")
              msdcvTP(t, i + 19) = msdcvTP(t, i + 19) / 1000
       End If
   Next i
   For i = 8 To 10
       If Abs(CSng(Trim(msdcvTP(t, i + 19)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(3) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i + 19)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(3) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "*" & Format(msdcvTP(t, i + 19), "#0.####0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "'" & Format(msdcvTP(t, i + 19), "#0.####0")
       End If
   Next i
   For i = 11 To 13
       If Abs(CSng(Trim(msdcvTP(t, i + 19)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(4) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i + 19)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(4) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "*" & Format(msdcvTP(t, i + 19), "##0.###0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "'" & Format(msdcvTP(t, i + 19), "##0.###0")
       End If
   Next i
   For i = 14 To 16
       If Abs(CSng(Trim(msdcvTP(t, i + 19)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(5) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i + 19)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(5) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "*" & Format(msdcvTP(t, i + 19), "###0.##0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "'" & Format(msdcvTP(t, i + 19), "###0.###0")
       End If
   Next i
   For i = 17 To 19
       If Abs(CSng(Trim(msdcvTP(t, i + 19)))) > msdcv(i) * (1 + 0.005 / 100) + dcvrange(6) * 0.001 / 100 + 5 / 1000000 Or _
          Abs(CSng(Trim(msdcvTP(t, i + 19)))) < msdcv(i) * (1 - 0.005 / 100) - dcvrange(6) * 0.001 / 100 - 5 / 1000000 Then
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "*" & Format(msdcvTP(t, i + 19), "####0.#0")
       Else
              xlwb.Worksheets("5101.1").Cells(i + 5, 5).Value = "'" & Format(msdcvTP(t, i + 19), "####0.#0")
       End If
   Next i
   End If
   
   'save ohm measure data
   
   If ohmnullflag <> 1 Then
   For i = 1 To 8
       If Abs(CSng(Trim(msrTP(t, i)))) > msr(i) * (1 + specohm2(i) / 100) Or _
          Abs(CSng(Trim(msrTP(