mditest.frm

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

Private Sub imgopen1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ToolTipflag = 1
   Timer1.Enabled = True
End Sub


Private Sub imgopen2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgopen1.Visible = True
imgopen2.Visible = False

mnuopen_Click

End Sub

Private Sub imgpaste1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgpaste2.Visible = True
imgpaste1.Visible = False

End Sub


Private Sub imgpaste1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ToolTipflag = 5
   Timer1.Enabled = True

End Sub


Private Sub imgpaste2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgpaste1.Visible = True
imgpaste2.Visible = False

If mnupaste.Enabled = True Then
   mnupaste_Click
End If

End Sub


Private Sub imgsave1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgsave2.Visible = True
imgsave1.Visible = False
End Sub


Private Sub imgsave1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ToolTipflag = 2
   Timer1.Enabled = True

End Sub


Private Sub imgsave2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgsave1.Visible = True
imgsave2.Visible = False

If mnusave.Enabled = True Then
   mnusave_Click
End If
End Sub



Private Sub MDIForm_Load()
   
   mdifomtest.Height = 6850
   mdifomtest.Top = -15
   
   Number = 1
   
   Saveflag = 0
   
   
   'Check Point
   chdcv = Array("19E-3", "19E-2", "19E-1", "19", "190", "1000")
   chdci = Array("0.19E-3", "1.9E-3", "19E-3", "0.19", "1")
   chohm = Array("1", "10", "100", "1E+3", "10E+3", "100E+3", "1E+6", "10E+6")
   chacv = Array("19E-3", "19E-2", "19E-1", "19", "100")

   
   'Test Point
   msdcv = Array(0.019, 0.01, 0.002, 0, 0.19, 0.1, 0.02, 1.9, 1, 0.2, 19, 10, 2, 190, 100, 20, 1000, 500, 200)
   msdci = Array(0.00019, 0.0001, 0.00002, 0.0019, 0.001, 0.0002, 0.019, 0.01, 0.002, 0.19, 0.1, 0.02, 1, 0.2)
   msaci = Array(0.00019, 0.0001, 0.00002, 0.0019, 0.001, 0.0002, 0.019, 0.01, 0.002, 0.19, 0.1, 0.02, 1, 0.2)
   msr = Array(1, 10, 100, 1000, 10000, 100000, 1000000, 10000000)
   msacv = Array(0.19, 0.1, 1.9, 1, 0.2, 19, 10, 2, 100, 20)
   msacvH = Array(190, 500, 200)
   
   'Test Range
   dcvrange = Array(0.019, 0.19, 1.9, 19, 190, 1000)
   dcirange = Array(0.00019, 0.0019, 0.019, 0.19, 1)
   acirange = Array(0.00019, 0.0019, 0.019, 0.19, 1)
   acvrange = Array(0.19, 1.9, 19, 190)
   acvHrange = Array(190, 1000)
   
   'ohm specification ini
   specohm2 = Array("0.02", "0.01", "0.005", "0.005", "0.005", "0.005", "0.01", "0.05")
End Sub


Private Sub mnuabout_Click()
    MsgBox "本程序所有权属于国防科工委第二计量中心" & Chr(13) & Chr(10) & "电学研究室数字表组!" & Chr(13) & Chr(10) & Chr(10) & "制作人：黄晶、王路权", vbOKOnly + vbInformation, "About"
End Sub

Private Sub mnucascade_Click()
   'Cascade child forms
   mdifomtest.Arrange vbCascade
End Sub

Private Sub mnuchacv_Click()
   Dim p, q, t As Integer
   Dim Response As Integer
       
   Response = MsgBox("请正确连接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 = "Check"
   
   'acvrange = Array(0.019, 0.19, 1.9, 19, 190)
   
   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
   send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   
   initialize
   send_order "NPLC 80;NDIG 7", 0
   fomcheck.lstchdata.AddItem "Check ACV:"
   '------------------检查ACV超差点--------------
   For q = 1 To 2
     If q = 1 Then
        fomcheck.lstchdata.AddItem "- 1 kHz"
     Else
        fomcheck.lstchdata.AddItem "- 10 kHz"
     End If
   For p = 1 To 5
         
     For t = 1 To Number
       initialize
       send_order "*", t
       send_order "0" & t, 11
       initialize
       send_order "C", t
       send_order "0V,N", t
       initialize
       wait 10

       Select Case p
       Case 1
          send_order "FUNC ACV 0.1;SETACV SYNC;RES .002;LFILTER ON", 0
       Case 2
          send_order "FUNC ACV 1;SETACV SYNC;RES .002;LFILTER ON", 0
       Case 3
          send_order "FUNC ACV 10;SETACV SYNC;RES .002;LFILTER ON", 0
       Case 4 To 5
          send_order "FUNC ACV 100;SETACV SYNC;RES .002;LFILTER ON", 0
       End Select
       wait 3
       initialize
       If q = 1 Then
          order = chacv(p) & "V1E3H,N"
       Else
          order = chacv(p) & "V10E3H,N"
       End If
       send_order order, t
       wait 25
       If q = 1 Then
          receive_data chacvFS(t, p), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(chacvFS(t, p), 16) & "V"
       Else
          receive_data chacvFS(t, p + 5), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(chacvFS(t, p + 5), 16) & "V"
       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
     Next t
   Next p
   Next q
   For t = 1 To Number
     send_order "*", t
     send_order "C", t
   Next t
   initialize
   send_order "00", 11
   
'   fomerror.lsterror.AddItem "out acv spec:"
' For t = 1 To Number
'   fomcheck.lstchdata.AddItem "- 1 kHz"
'   For p = 1 To 5
'      If CSng(Trim(chacvFS(t, p))) > chacv(p) * (1 + 0.05 / 100) + acvrange(p) * 0.005 / 100 + 50 / 1000000 Or _
'         CSng(Trim(chacvFS(t, p))) < chacv(p) * (1 - 0.05 / 100) - acvrange(p) * 0.005 / 100 - 50 / 1000000 Then
'              fomerror.lsterror.AddItem "(" & t & ")" & Left(chacvFS(t, p), 16) & "V"
'      End If
'   Next p
'   fomcheck.lstchdata.AddItem "- 10 kHz"
'   For p = 1 To 5
'      If CSng(Trim(chacvFS(t, p + 5))) > chacv(p) * (1 + 0.05 / 100) + acvrange(p) * 0.005 / 100 + 50 / 1000000 Or _
'         CSng(Trim(chacvFS(t, p + 5))) < chacv(p) * (1 - 0.05 / 100) - acvrange(p) * 0.005 / 100 - 50 / 1000000 Then
'              fomerror.lsterror.AddItem "(" & t & ")" & Left(chacvFS(t, p + 5), 16) & "V"
'      End If
'   Next p
' Next t
  
   
   picstatue.Cls
   picstatue.Print "检查完毕！"
   
   mnuchohm_Click

End Sub

Private Sub mnuchdci_Click()
   Dim p, t As Integer
   Dim Response As Integer

       
   Response = MsgBox("请正确连接DCI测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Current Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
   
   picstatue.Cls
   picstatue.Print "现在进行DCI的功能检查！(按Shift + F2键可中断程序运行)"
   
   fomcheck.Show
   fomcheck.Caption = "Check"
   
   'dcirange = Array(0.00019, 0.0019, 0.019, 0.19, 1)
         
   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 "S", t
   Next t

   
   initialize
   send_order "NPLC 80;NDIG 6", 0
   fomcheck.lstchdata.AddItem "Check DCI:"
   initialize

  '------------------检查DCI超差点--------------
     For p = 1 To 5
       initialize
       
       Select Case p
         Case 1
            send_order "FUNC DCI,1E-3", 0
         Case 2
            send_order "FUNC DCI,1E-2", 0
         Case 3
            send_order "FUNC DCI,1E-1", 0
         Case 4 To 5
            send_order "FUNC DCI,1", 0
       End Select
       initialize
       For t = 1 To Number
           initialize
           send_order "*", t
       Next t
       wait 7
       send_order "MATH NULL", 0
       initialize
       wait 5
       'send_order "C", 1
       For t = 1 To Number
          order = "+" & chdci(p) & "A,N"
          send_order "0" & t, 11
          initialize
          send_order order, t
          wait 12
          receive_data chdciFS(t, p), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(chdciFS(t, p), 16) & "A"
          initialize
          send_order "S", t
          initialize
          send_order "MEM LIFO", 0
          initialize
       Next t
       wait 1
   
       If keyflag = 1 Then
          picstatue.Cls
          picstatue.Print "中断程序运行!"
          keyflag = 0
          send_order "*", 1
          send_order "RESET", 0
          Exit Sub
       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
        
'     fomerror.lsterror.AddItem "out dci spec:"
'   For t = 1 To Number
'     For p = 1 To 5
'        If CSng(Trim(chdciFS(t, p))) > dcirange(p) * (1 + 0.0275 / 100) + 0.01 / 1000000 Or _
'           CSng(Trim(chdciFS(t, p))) < dcirange(p) * (1 - 0.0275 / 100) - 0.01 / 1000000 Then
'                fomerror.lsterror.AddItem "(" & t & ")" & Left(chdciFS(t, p), 16) & "A"
'        End If
'     Next p
'   Next t
     
        
     picstatue.Cls
     picstatue.Print "检查完毕！"
     
     mnuchdcv_Click

End Sub


Private Sub mnuchdcv_Click()
   Dim p, q, t As Integer
   Dim Response As Integer
   
   'send_order "01", 11
   Response = MsgBox("请正确连接DCV测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Voltage Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
   
   fomcheck.Show
   fomcheck.Caption = "Check"
      
   picstatue.Cls
   picstatue.Print "现在进行DCV的功能检查！(按Shift + F2键可中断程序运行)"
   
   'dcvrange = Array(0.019, 0.19, 1.9, 19, 190, 1000)
   
   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
   send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   initialize
   send_order "NPLC 80;NDIG 7", 0
   fomcheck.lstchdata.AddItem "Check DCV:"
   '------------------检查DCV超差点--------------
   For q = 1 To 2                      '+.- polarity
   For p = 1 To 6                      '6 ranges
        
     For t = 1 To Number
       initialize
       send_order "0" & t, 11
       send_order "0V,N", t
       wait 1

       Select Case p
       Case 1
          send_order "FUNC DCV 0.1 ", 0
       Case 2
          send_order "FUNC DCV 1", 0
       Case 3
          send_order "FUNC DCV 10", 0
       Case 4
          send_order "FUNC DCV 100", 0
       Case 5 To 6
          send_order "FUNC DCV 1000", 0
       End Select
       initialize
       wait 9
       send_order "MATH NULL", 0
       initialize
       wait 6
       If q = 1 Then
          order = "+" & chdcv(p) & "V,N"
       Else
          order = "-" & chdcv(p) & "V,N"
       End If
       send_order "0" & t, 11
       initialize
       send_order order, t
       wait 12
       If q = 1 Then
           receive_data chdcvFS(t, p), 0
           fomcheck.lstchdata.AddItem "(" & t & ")" & Left(chdcvFS(t, p), 16) & "V"
       Else
           receive_data chdcvFS(t, p + 6), 0
           fomcheck.lstchdata.AddItem "(" & t & ")" & Left(chdcvFS(t, p + 6), 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