mditest.frm

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

   Next q
   For t = 1 To Number
      initialize
      send_order "*", t
      send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
'   fomerror.lsterror.AddItem "out dcv spec:"
' For t = 1 To Number
'   For p = 1 To 6
'      If CSng(Trim(chdcvFS(t, p))) > dcvrange(p) * (1 + 0.006 / 100) + 5 / 1000000 Or _
'         CSng(Trim(chdcvFS(t, p))) < dcvrange(p) * (1 - 0.006 / 100) - 5 / 1000000 Then
'              fomerror.lsterror.AddItem "(" & t & ")" & Left(chdcvFS(t, p), 16) & "V"
'      End If
'   Next p
'   For p = 1 To 6
'      If Abs(CSng(Trim(chdcvFS(t, p + 6)))) > dcvrange(p) * (1 + 0.006 / 100) + 5 / 1000000 Or _
'         Abs(CSng(Trim(chdcvFS(t, p + 6)))) < dcvrange(p) * (1 - 0.006 / 100) - 5 / 1000000 Then
'              fomerror.lsterror.AddItem "(" & t & ")" & Left(chdcvFS(t, p + 6), 16) & "V"
'      End If
'   Next p
' Next t
   
      
   picstatue.Cls
   picstatue.Print "检查完毕！"
   
   mnuchacv_Click

End Sub



Private Sub mnuchinpadds_Click()
   mnumsinpadds_Click
End Sub

Private Sub mnuchohm_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 = "Check"
  
   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 "Check OHM:"
   initialize
  '------------------检查R超差点--------------
   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 = chohm(p) & "ZX1,N"
        send_order "0" & t, 11
        initialize
        send_order "C", t
        send_order order, t
        wait 60
        receive_data chohmFS(t, p), 0
        fomcheck.lstchdata.AddItem "(" & t & ")" & Left(chohmFS(t, p), 16) & "ohm"
        initialize
        wait 1
        initialize
        send_order "MEM LIFO", 0
        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
   For t = 1 To Number
      initialize
      send_order "*", t
      send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
      
'   fomerror.lsterror.AddItem "out ohm spec:"
'   For t = 1 To Number
'   For p = 1 To 8
'      If CSng(Trim(chohmFS(t, p))) > ohmrange(p) * (1 + specohm2(p) / 100) Or _
'         CSng(Trim(chohmFS(t, p))) < ohmrange(p) * (1 - specohm2(p) / 100) Then
'             fomerror.lsterror.AddItem "(" & t & ")" & Left(chohmFS(t, p), 16) & "ohm"
'      End If
'   Next p
'   Next t

   picstatue.Cls
   picstatue.Print "检查完毕！"

   mnuchdci_Click

End Sub


Private Sub mnucopy_Click()
Clipboard.Clear
If TypeOf Screen.ActiveControl Is ListBox Then
   Clipboard.SetText Screen.ActiveControl.Text
ElseIf TypeOf Screen.ActiveControl Is TextBox Then
   Clipboard.SetText Screen.ActiveControl.SelText
End If
End Sub

Private Sub mnucut_Click()
Clipboard.Clear
If TypeOf Screen.ActiveControl Is ListBox Then
   Clipboard.SetText Screen.ActiveControl.Text
   Screen.ActiveControl.RemoveItem Screen.ActiveControl.ListIndex
ElseIf TypeOf Screen.ActiveControl Is TextBox Then
   Clipboard.SetText Screen.ActiveControl.SelText
   Screen.ActiveControl.SelText = ""
End If

End Sub


Private Sub mnuedit_Click()
   mnucut.Enabled = True
   mnucopy.Enabled = True
   mnupaste.Enabled = False

   If TypeOf Screen.ActiveControl Is TextBox Then
      If Clipboard.GetFormat(vbCFText) Then mnupaste.Enabled = True
   ElseIf TypeOf Screen.ActiveControl Is ListBox Then
      If Clipboard.GetFormat(vbCFText) Then mnupaste.Enabled = True
   Else
      mnucut.Enabled = False
      mnucopy.Enabled = False
   End If
End Sub

Private Sub mnumsaci_Click()
   
   Dim p, q, t As Integer
   Dim Response As Integer
       
   Response = MsgBox("请正确连接5101B与3458A之间的ACI测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Current Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If

   picstatue.Cls
   picstatue.Print "现在进行ACI的功能测试！(按Shift + F2键可中断程序运行)"
   
   fomcheck.Show
   fomcheck.Caption = "Test"
   
   'msaci = Array(190E-6, 100E-6, 20E-6, 1.9E-3, 1E-3, 0.2E-3, 19E-3, 10E-3, 2E-3, 190E-3, 100E-3, 20E-3,1,0.2)
   
   initialize                      'test interface IEEE488
   receive_data temp, 0
   If IEEnoteflag = vbOK Then
      Exit Sub
   End If
   
   initialize
   For t = 1 To Number
      send_order "*", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   initialize
   send_order "NPLC 80;NDIG 6", 0
   initialize
   fomcheck.lstchdata.AddItem "TEST ACI - 5101B:"
   '5101------------------ACV--------------
   For q = 1 To 3
     If q = 1 Then
        fomcheck.lstchdata.AddItem "- 60 Hz"
     ElseIf q = 2 Then
        fomcheck.lstchdata.AddItem "- 500 Hz"
     Else
        fomcheck.lstchdata.AddItem "- 1 kHz"
     End If
   For p = 1 To 14
     For t = 1 To Number
       initialize
       If msaci(p) <= 0.0001 Then
          send_order "FUNC ACI 0.0001", 0
       ElseIf msaci(p) <= 0.001 Then
          send_order "FUNC ACI 0.001", 0
       ElseIf msaci(p) <= 0.01 Then
          send_order "FUNC ACI 0.01", 0
       ElseIf msaci(p) <= 0.1 Then
          send_order "FUNC ACI 0.1", 0
       Else
          send_order "FUNC ACI 1", 0
       End If
       wait 5
       initialize
       If q = 1 Then
          order = msaci(p) & "A60H,N"
       ElseIf q = 2 Then
          order = msaci(p) & "A5E2H,N"
       Else
          order = msaci(p) & "A1E3H,N"
       End If
       send_order "0" & t, 11
       send_order "C", t
       send_order order, t
       wait 15
       If q = 1 Then
          receive_data msaci51(t, p), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msaci51(t, p), 16) & "A"
       ElseIf q = 2 Then
          receive_data msaci51(t, p + 14), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msaci51(t, p + 14), 16) & "A"
       Else
          receive_data msaci51(t, p + 28), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msaci51(t, p + 28), 16) & "A"
       End If
       initialize
       wait 1
       
       If keyflag = 1 Then
         picstatue.Cls
         picstatue.Print "中断程序运行!"
         keyflag = 0
         send_order "*", t
         send_order "RESET", 0
         Exit Sub
       End If
       
       send_order "S", t
     Next t
   Next p
     For t = 1 To Number
         send_order "S", t
     Next t
   Next q
   For t = 1 To Number
      send_order "*", t
      send_order "C", t
   Next t
   initialize
   send_order "00", 11
   
   Response = MsgBox("请正确连接5700A与3458A之间的ACI测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Current Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
   
   initialize
   send_order "*rst", 20
   send_order "*cls", 20
   
   initialize                      'test interface IEEE488
   receive_data temp, 0
   If IEEnoteflag = vbOK Then
      Exit Sub
   End If
   send_order "stby", 20
   
   initialize
   send_order "NPLC 80;NDIG 6", 0
   initialize
   fomcheck.lstchdata.AddItem "TEST ACI - 5700A:"
   '5700------------------ACV--------------
   For q = 1 To 3
     If q = 1 Then
        fomcheck.lstchdata.AddItem "- 60 Hz"
     ElseIf q = 2 Then
        fomcheck.lstchdata.AddItem "- 500 Hz"
     Else
        fomcheck.lstchdata.AddItem "- 1 kHz"
     End If
   For p = 1 To 14
       If msaci(p) <= 0.0001 Then
          send_order "FUNC ACI 0.0001", 0
       ElseIf msaci(p) <= 0.001 Then
          send_order "FUNC ACI 0.001", 0
       ElseIf msaci(p) <= 0.01 Then
          send_order "FUNC ACI 0.01", 0
       ElseIf msaci(p) <= 0.1 Then
          send_order "FUNC ACI 0.1", 0
       Else
          send_order "FUNC ACI 1", 0
       End If
       wait 5
       initialize
       If q = 1 Then
          order = "out " & msaci(p) & "A,60Hz;oper"
       ElseIf q = 2 Then
          order = "out " & msaci(p) & "A,500Hz;oper"
       Else
          order = "out " & msaci(p) & "A,1kHz;oper"
       End If
       send_order order, 20
       wait 15
       If q = 1 Then
          receive_data msaci57(p), 0
          fomcheck.lstchdata.AddItem Left(msaci57(p), 16) & "A"
       ElseIf q = 2 Then
          receive_data msaci57(p + 14), 0
          fomcheck.lstchdata.AddItem Left(msaci57(p + 14), 16) & "A"
       Else
          receive_data msaci57(p + 28), 0
          fomcheck.lstchdata.AddItem Left(msaci57(p + 28), 16) & "A"
       End If
       initialize
       wait 1
       If keyflag = 1 Then
          picstatue.Cls
          picstatue.Print "中断程序运行!"
          keyflag = 0
          send_order "*rst", 20
          send_order "RESET", 0
          Exit Sub
       End If
       
       If p = 1 Or p = 4 Or p = 7 Or p = 10 Then
          send_order "stby", 20
       End If

   Next p
       send_order "stby", 20
   Next q
   send_order "*cls", 20
   send_order "*rst", 20
   send_order "RESET", 0
   initialize
 
   picstatue.Cls
   picstatue.Print "测试完毕！"
   
   Saveflag = 1
      
   mdifomtest.mnusave.Enabled = True
   mdifomtest.imgsave1.Enabled = True
   mdifomtest.imgsave2.Enabled = True
End Sub


Private Sub mnumsacvH_Click()
   Dim p, q, t As Integer
   Dim Response As Integer
   
   Response = MsgBox("请正确连接多台5101B与3458A之间ACV测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Voltage Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
   
   picstatue.Cls
   picstatue.Print "现在进行ACV的功能测试！(按Shift + F2键可中断程序运行)"
   
   fomcheck.Show
   fomcheck.Caption = "Test"
   
   'msacvH = Array(190, 500, 200)
   
   initialize                      'test interface IEEE488
   receive_data temp, 0
   If IEEnoteflag = vbOK Then
      Exit Sub
   End If
   
   initialize
   For t = 1 To Number
      send_order "*", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   
   initialize
   send_order "NPLC 80;NDIG 7", 0
   initialize
   send_order "FUNC ACV 1000;SETACV SYNC;LFILTER ON", 0
   wait 3
   initialize
   
   fomcheck.lstchdata.AddItem "TEST ACV - 5101B:"
   '5101B------------------ACV--------------
   For q = 1 To 3
     If q = 1 Then
        fomcheck.lstchdata.AddItem "- 60 Hz"
     ElseIf q = 2 Then
        fomcheck.lstchdata.AddItem "- 500 Hz"
     Else
        fomcheck.lstchdata.AddItem "- 1 kHz"
     End If
   For p = 1 To 3
     For t = 1 To Number
       initialize
       send_order "*", t                 '防止ERROR - 触发太快
       initialize
       send_order "0" & t, 11
       initialize
       send_order "0V,N", t