Attribute VB_Name = "HpMod"
'Keithley multimeter addresss
'Global intAddress2400dx
'Keithley scanner addresss
Global Scanad%
'Global a23% 'indirizzo 230
'Global a27% 'indirizzo 2700
Public bytInit As Byte


Sub testres(percentage!, perc1!, guard%, theresval!, level%, prt%, ok%)
ok% = 1
theValOhm! = thefinalval!
If thefinalval! = 0 Then Call ReadResInTensione(theval!, theresval!, theValOhm!)
thematrix$(4003) = Trim(Str(theValOhm!))
realper! = Int(1000 * (theresval! - theValOhm!) / theresval!)
'Exit Sub
realper! = realper! / 10
If perc1! <> 0 Then
    If Abs(realper!) <= Abs(perc1!) Then
            If prt% = 1 Then
                mr$ = "Pretest OK:" + Str$(theValOhm!) + " (" + Trim$(Str$(-realper!)) + "%)"
                Call updatereport(mr$, 2)
            End If
            perc1! = 1
            Exit Sub
    Else
       prt% = 0
    End If
Else
    prt% = 0
End If
perc1! = 0
If level% = 1 Then
    'puo' stare entro valore - percentuale
    If realper! < 0 Then
        tooh% = 1
    End If
    If realper! > percentage! Then
        tool% = 1
    End If
End If
If level% = 2 Then
    'puo' stare entro valore + percentuale
    If realper! > 0 Then
        tool% = 1
    End If
    If realper! < -percentage! Then
        tooh% = 1
    End If
End If
If level% = 3 Then
    'puo' stare entro valore +/- percentuale
    If (realper! > percentage!) Then
        tool% = 1
    End If
    If (realper! < -percentage!) Then
        tooh% = 1
    End If
End If
If tooh% = 1 Then
    ok% = 0
End If
If tool% = 1 Then
    ok% = 0
End If
If prt% = 1 Then
    If ok% = 1 Then
        Select Case level%
        Case 1, 2
            clr% = 0
            mr$ = "Pretest OK:"
        Case 3
            clr% = 2
            mr$ = "Test OK:"
        End Select
    Else
        clr% = 1
        Select Case level%
        Case 1, 2
            mr$ = "Pretest Fail:"
        Case 3
            mr$ = "Test Fail:"
        End Select
    End If
    mr$ = mr$ + Str$(theValOhm!) + " (" + Trim$(Str$(-realper!)) + "%)"
    nok% = ok% Xor 1
    Call updatereport(mr$, clr%)
    theresval! = theValOhm!
Else
   If ok% = 0 Then
      Select Case level%
        Case 1, 2
            mr$ = "Pretest Fail:"
        Case 3
            mr$ = "Test Fail:"
      End Select
      mr$ = mr$ + Str$(theValOhm!) + " (" + Trim$(Str$(-realper!)) + "%)"
      nok% = ok% Xor 1
      Call updatereport(mr$, clr%)
   End If
End If

End Sub

Sub trimrOld(rnom1!, rnom2!, percentage!, timout%, intDigit As Integer)
   'taglio a stop singolo o doppio
   'se singolo su OUT 0
   'se doppio prima Out 1 poi Out 0
   dcut% = 0
   PowLimit! = PowerTrim '0.01
   If rnom1! = 0 Then
        MsgBox ("Impossible with null resistor values!")
        Exit Sub
   End If
   If (rnom2! <> 0) And (rnom2! > rnom1!) Then
        dcut% = 1
   Else
        rnom2! = 0
   End If
   'pretest su tolleranza accettazione
   Call ReadResOld(theval!, 0)
   thenom! = rnom1!
   If rnom2! > 0 Then thenom! = rnom2!
    lowval! = thenom! - (thenom! * cleanval(myrecord.tolcut)) / 100
    highval! = thenom! + (thenom! * cleanval(myrecord.tolcut)) / 100
   ' If theval! > lowval! Then
   '         MsgBox ("Resistor test too low")
   '         Call send(intAddress2400dx, "*RST", stat%)
   '         Call send(intAddress2400dx, ":OUTPUT OFF", stat%)
   '         Exit Sub
   ' End If
   ' If theval! > highval! Then
   '         MsgBox ("Resistor test too high")
   '            Call send(intAddress2400dx, "*RST", stat%)
   '             Call send(intAddress2400dx, ":OUTPUT OFF", stat%)
   '         Exit Sub
   ' End If
   'inizio taglio
   Call initsystem(1, 0, 1, 1, 1)
   If intDigit = 0 Then
      Call send(intAddress2400dx, ":DISP:DIG 5", stat%)
   Else
      Call send(intAddress2400dx, ":DISP:DIG " + Str(intDigit), stat%)
   End If
   Call send(intAddress2400dx, ":SENS:FUNC 'VOLT:DC'", stat%) ' Sense Voltage
   Call send(intAddress2400dx, ":SENS:VOLT:NPLC 0.01", stat%)    ' Integration rate Influrnza la velocita'
  ' Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 200", stat%)
   Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 150", stat%) ' Voltage Compliance
   Call send(intAddress2400dx, ":SOUR:FUNC CURR", stat%)   ' Source Current
   If rnom2! > 0 Then
        iset! = Sqr(PowLimit! / rnom2!)    ' Valore della Corrente di taratura
        If iset! > 1 Then iset! = 1
        vset2! = Sqr(PowLimit! * rnom2!)
        If vset2! > 100 Then
            vset2! = 100
            iset! = 100 / rnom2!
        End If
        vset1! = rnom1! * iset!
   Else
        iset! = Sqr(PowLimit! / rnom1!)
        If iset! > 1 Then iset! = 1
        vset1! = iset! * rnom1!
        If vset1! > 100 Then
            vset1! = 100
            iset! = 100 / rnom1!
        End If
   End If
   If dcut% = 0 Then
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vset1!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
        Select Case vset1!
        Case Is < 2
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 2", stat%)
        Case 2 To 20
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 20", stat%)
        Case Is > 20
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 200", stat%)
        End Select
   Else
        Call send(intAddress2400dx, ":CALC2:LIM2:UPP" + Str(vset1!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM2:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM2:UPP:SOUR2 14", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vset2!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
        Select Case vset2!
        Case Is < 2
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 2", stat%)
        Case 2 To 20
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 20", stat%)
        Case Is > 20
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 200", stat%)
        End Select
   End If
   Call send(intAddress2400dx, ":SOUR:CURR:IMM" + Str(iset!), stat%) ' Source Current IMMediate 1 mA
   Call send(intAddress2400dx, ":SOUR:DEL 0.001", stat%)   ' Source Delay 1 mS
   Call send(intAddress2400dx, ":CALC2:FEED VOLT", stat%)
   Call send(intAddress2400dx, ":CALC2:CLIM:PASS:SOUR2 15", stat%)
   Call send(intAddress2400dx, ":CALC2:CLIM:BCON IMM", stat%)
   Call send(intAddress2400dx, ":TRIG:DELAY 0.001", stat%)
   Call send(intAddress2400dx, ":TRIG:COUNT 1", stat%)
   Call send(intAddress2400dx, ":ARM:COUN INF", stat%)   ' ARM
   Call send(intAddress2400dx, ":STAT:QUE:CLEAR", stat%)    '
   Call send(intAddress2400dx, ":STAT:PRES", stat%)    ' Status preset
   Call send(intAddress2400dx, "*SRE 1", stat%)    ' SRQ
   Call send(intAddress2400dx, "*CLS", stat%)       ' reset Status Byte Register  per SRQ
   Call send(intAddress2400dx, ":CALC2:LIM1:STAT 0", stat%)
   If dcut% = 1 Then
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 1", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 0", stat%)
        Call send(intAddress2400dx, ":STAT:MEAS:ENAB 4", stat%)    ' Limit 2  FAIL
   Else
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 0", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 1", stat%)
        Call send(intAddress2400dx, ":STAT:MEAS:ENAB 16", stat%)    ' Limit 3  FAIL
   End If
   Call send(intAddress2400dx, ":OUTPUT ON", stat%)
   Call send(intAddress2400dx, ":INIT", stat%)
   'parte restante per massi inutile
   'dt! = Timer
   'ok% = 0
   'Do
   '     DoEvents
    '    Call spoll(intAddress2400dx, poll%, stat%)
     '   If (poll% And 64) = 64 Then
      '      If dcut% = 0 Then
       '         ok% = 1
        '        Exit Do
         '   Else
          '      If ok% = -1 Then
           '         dddttt2& = timeGetTime&
            ''        dddttt& = dddttt2& - dddttt1&
                '    ok% = 1
              ''      Exit Do
'                Else
 '                   ok% = -1
  '                  dddttt1& = timeGetTime&
   '                 Call send(intAddress2400dx, ":ABORT", stat%)     ' reset trigger buffer
    '                Call send(intAddress2400dx, ":STAT:QUE:CLEAR", stat%)    '
     '               Call send(intAddress2400dx, ":STAT:PRES", stat%)    ' Status preset
      '              Call send(intAddress2400dx, "*SRE 1", stat%)    ' SRQ
       '             Call send(intAddress2400dx, "*CLS", stat%)       ' reset Status Byte Register  per SRQ
        '            Call send(intAddress2400dx, ":CALC2:LIM1:STAT 0", stat%)
         '           Call send(intAddress2400dx, ":CALC2:LIM2:STAT 0", stat%)
          '          Call send(intAddress2400dx, ":CALC2:LIM3:STAT 1", stat%)
           ''         Call send(intAddress2400dx, ":STAT:MEAS:ENAB 16", stat%)    ' Limit 3  FAIL
             '       Call send(intAddress2400dx, ":INIT", stat%)
              '  End If
'            End If
 '       End If
  '      If Timer - dt! < 0 Then dt! = Timer
   'Loop While Timer - dt! < timout%
   'dtt& = timeGetTime&()
   'Call readres(theval!)
   'rv! = theval!
   'dtt1& = timeGetTime&()
   'Delta& = dtt1& - dtt&
   'Call send(intAddress2400dx, "*RST", stat%)
   'If ok% <= 0 Then
        'Call MsgBox("Trim timeout")
   'Else
        'finv! = rnom1!
        'If dcut% = 1 Then finv! = rnom2!
        'pc! = Abs(rv! - finv!) / finv!
        'ppcc% = CInt(pc! * 10000!)
        'pc! = ppcc% / 100
        'if pc! < percentage! Then
            'MsgBox ("Done" + Str(pc!) + "%")
        'Else
            'MsgBox ("Failure:" + Str(pc!) + "%")
        'End If
   'End If
End Sub

Sub trimrSecondCut()
'serve per settare il secondo comparatore per un taglio a L o Doppio

 Call send(intAddress2400dx, ":ABORT", stat%)     ' reset trigger buffer
 Call send(intAddress2400dx, ":STAT:QUE:CLEAR", stat%)    '
 Call send(intAddress2400dx, ":STAT:PRES", stat%)    ' Status preset
 Call send(intAddress2400dx, "*SRE 1", stat%)    ' SRQ
 Call send(intAddress2400dx, "*CLS", stat%)       ' reset Status Byte Register  per SRQ
 Call send(intAddress2400dx, ":CALC2:LIM1:STAT 0", stat%)
 Call send(intAddress2400dx, ":CALC2:LIM2:STAT 0", stat%)
 Call send(intAddress2400dx, ":CALC2:LIM3:STAT 1", stat%)
 Call send(intAddress2400dx, ":STAT:MEAS:ENAB 16", stat%)    ' Limit 3  FAIL
 Call send(intAddress2400dx, ":INIT", stat%)

End Sub

Sub setcutr(dcut%, guard%, rnom1!, rnom2!)
   PowLimit! = PowerTrim '0.01
   Debug.Print rnom1!
   Debug.Print rnom2!
   Call initsystem(1, guard%, 1, 1, 1)
   Call send(intAddress2400dx, ":SENS:VOLT:NPLC 0.01", stat%)    ' Integration rate Influenza la velocita'
   'Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE:AUTO 1", stat%)
   Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 60", stat%) ' Voltage Compliance
   'Call send(intAddress2400dx, ":SENS:AVER:TCON REP", stat%)
    'Call send(intAddress2400dx, ":SENS:AVER:COUN 10", stat%)
    'Call send(intAddress2400dx, ":SENS:AVER ON", stat%)
    Call send(intAddress2400dx, ":SOUR:FUNC CURR", stat%)   ' Source Current
   If rnom2! > 0 Then
        iset! = Sqr(PowLimit! / rnom2!)    ' Valore della Corrente di taratura
        If iset! > 1 Then iset! = 1
        vset2! = Sqr(PowLimit! * rnom2!)
        If vset2! > 48 Then
            vset2! = 48
            iset! = 48 / rnom2!
        End If
        vset1! = rnom1! * iset!
        Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE" + Str((Val(vset2!) + Val(vset1!)) / 2), stat%)
   Else
        iset! = Sqr(PowLimit! / rnom1!)
        If iset! > 1 Then iset! = 1
        vset1! = iset! * rnom1!
        If vset1! > 48 Then
            vset1! = 48
            iset! = 48 / rnom1!
        End If
        Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE" + Str(vset1!), stat%)
   End If
   theiset! = iset!
   Call send(intAddress2400dx, ":SOUR:CURR:IMM" + Str(iset!), stat%) ' Source Current IMMediate 1 mA
   Call send(intAddress2400dx, ":SOUR:DEL 0.001", stat%)   ' Source Delay 1 mS
   Call send(intAddress2400dx, ":CALC2:FEED VOLT", stat%)
   If dcut% = 0 Then
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vset1!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
   Else
        Call send(intAddress2400dx, ":CALC2:LIM2:UPP" + Str(vset1!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM2:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM2:UPP:SOUR2 14", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vset2!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
   End If
   Call send(intAddress2400dx, ":CALC2:CLIM:PASS:SOUR2 15", stat%)
   Call send(intAddress2400dx, ":CALC2:CLIM:BCON IMM", stat%)
   Call send(intAddress2400dx, ":TRIG:DELAY 0.001", stat%)
   Call send(intAddress2400dx, ":TRIG:COUNT 10", stat%)
   Call send(intAddress2400dx, ":ARM:COUN INF", stat%)   ' ARM
   Call send(intAddress2400dx, ":STAT:QUE:CLEAR", stat%)    '
   Call send(intAddress2400dx, ":STAT:PRES", stat%)    ' Status preset
   Call send(intAddress2400dx, "*SRE 1", stat%)    ' SRQ
   Call send(intAddress2400dx, "*CLS", stat%)       ' reset Status Byte Register  per SRQ
   Call send(intAddress2400dx, ":CALC2:LIM1:STAT 0", stat%)
   If dcut% = 1 Then
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 1", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 0", stat%)
        Call send(intAddress2400dx, ":STAT:MEAS:ENAB 4", stat%)    ' Limit 2  FAIL
   Else
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 0", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 1", stat%)
        Call send(intAddress2400dx, ":STAT:MEAS:ENAB 16", stat%)    ' Limit 3  FAIL
   End If
   Call send(intAddress2400dx, ":OUTPUT ON", stat%)
   'call send(intAddress2400dx, ":READ?", stat%)
    'rx$ = Space$(255)
    'Call enter(rx$, 255, rl%, intAddress2400dx, stat%)
    'theinitval! = Val(rx$) / iset!
    Call send(intAddress2400dx, ":INIT", stat%)
    'Call send(intAddress2400dx, ":ARM:COUN INF", stat%)   ' ARM
End Sub
Sub setcutv(dcut%, guard%, vnom1!, vnom2!, up%)
   Call initsystem(1, 0, 1, 1, 1)
   'Call send(intAddress2400dx, ":FORM:ELEM VOLT", stat%)     ' legge solo la resistenza    Call send(intAddress2400dx, ":SENS:FUNC 'VOLT:DC'", stat%) ' Sense Voltage
   Call send(intAddress2400dx, ":SENS:FUNC 'VOLT:DC'", stat%) ' Sense Voltage
   Call send(intAddress2400dx, ":SENS:VOLT:NPLC 0.01", stat%)    ' Integration rate Influrnza la velocita'
   Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE:AUTO 1", stat%)
   Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 150", stat%) ' Voltage Compliance
   Call send(intAddress2400dx, ":SENS:AVER:TCON REP", stat%)
   Call send(intAddress2400dx, ":SENS:AVER:COUN 10", stat%)
   Call send(intAddress2400dx, ":SENS:AVER ON", stat%)
   Call send(intAddress2400dx, ":SOUR:FUNC CURR", stat%)   ' Source Current
   Call send(intAddress2400dx, ":SOUR:CURR:IMM 0", stat%) ' Source Current IMMediate 1 mA
   Call send(intAddress2400dx, ":SOUR:DEL 0.001", stat%)   ' Source Delay 1 mS
   Call send(intAddress2400dx, ":CALC2:FEED VOLT", stat%)
   If dcut% = 0 Then
        If up% = 0 Then
            Call send(intAddress2400dx, ":CALC2:LIM3:UPP 100", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:LOW" + Str(vnom1!), stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:LOW:SOUR2 13", stat%)
        Else
            Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vnom1!), stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:LOW -100", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
        End If
   Else
        If up% = 0 Then
            Call send(intAddress2400dx, ":CALC2:LIM2:UPP 100", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM2:LOW" + Str(vnom1!), stat%)
            Call send(intAddress2400dx, ":CALC2:LIM2:LOW:SOUR2 14", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:UPP 100", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:LOW" + Str(vnom2!), stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:LOW:SOUR2 13", stat%)
        Else
            Call send(intAddress2400dx, ":CALC2:LIM2:UPP" + Str(vnom1!), stat%)
            Call send(intAddress2400dx, ":CALC2:LIM2:LOW -100", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM2:UPP:SOUR2 14", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vnom2!), stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:LOW -100", stat%)
            Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
        End If
   End If
   Call send(intAddress2400dx, ":CALC2:CLIM:PASS:SOUR2 15", stat%)
   Call send(intAddress2400dx, ":CALC2:CLIM:BCON IMM", stat%)
   Call send(intAddress2400dx, ":TRIG:DELAY 0.001", stat%)
   Call send(intAddress2400dx, ":TRIG:COUNT 10", stat%)
   Call send(intAddress2400dx, ":ARM:COUN INF", stat%)   ' ARM
   Call send(intAddress2400dx, ":STAT:QUE:CLEAR", stat%)    '
   Call send(intAddress2400dx, ":STAT:PRES", stat%)    ' Status preset
   Call send(intAddress2400dx, "*SRE 1", stat%)    ' SRQ
   Call send(intAddress2400dx, "*CLS", stat%)       ' reset Status Byte Register  per SRQ
   Call send(intAddress2400dx, ":CALC2:LIM1:STAT 0", stat%)
   If dcut% = 1 Then
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 1", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 0", stat%)
        If up% = 0 Then
            Call send(intAddress2400dx, ":STAT:MEAS:ENAB 2", stat%)    ' Limit 3  FAIL
        Else
            Call send(intAddress2400dx, ":STAT:MEAS:ENAB 4", stat%)    ' Limit 3  FAIL
        End If
   Else
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 0", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 1", stat%)
        If up% = 0 Then
            Call send(intAddress2400dx, ":STAT:MEAS:ENAB 8", stat%)    ' Limit 3  FAIL
        Else
            Call send(intAddress2400dx, ":STAT:MEAS:ENAB 16", stat%)    ' Limit 3  FAIL
        End If
   End If
   Call send(intAddress2400dx, ":OUTPUT ON", stat%)
   'Call send(intAddress2400dx, ":READ?", stat%)
    'rx$ = Space$(255)
    'Call enter(rx$, 255, rl%, intAddress2400dx, stat%)
    'theinitval! = Val(rx$)
    'Call send(intAddress2400dx, ":ARM:COUN INF", stat%)   ' ARM
    Call send(intAddress2400dx, ":INIT", stat%)
End Sub


Sub ReadResOld(theval!, guard%)
'legge una resistenza con campionamento singolo
'Call initsystem(1, guard%, 0, 1, 1)
'Call send(intAddress2400dx, ":SOUR:FUNC VOLT", stat%)   ' Source Current
'Call send(intAddress2400dx, ":SOUR:VOLT:IMM 0", stat%) ' Source Current IMMediate 1 mA
'Call send(intAddress2400dx, ":SOUR:DEL 0.001", stat%)   ' Source Delay 1 mS
'Call send(intAddress2400dx, ":OUTPUT ON", stat%)
'Call Delay(100)
Call initsystem(1, guard%, 1, 1, 1)
Call send(intAddress2400dx, ":FORM:ELEM RES", stat%)     ' legge solo la resistenza
Call send(intAddress2400dx, ":SENS:FUNC 'RES'", stat%)
Call send(intAddress2400dx, ":ARM:COUNT 1", stat%)
Call send(intAddress2400dx, ":TRIG:COUNT 1", stat%)
Call send(intAddress2400dx, ":TRIG:SOURCE IMM", stat%)
Call send(intAddress2400dx, ":TRIG:DELAY 0", stat%)
Call send(intAddress2400dx, ":OUTPUT ON", stat%)
Call send(intAddress2400dx, ":READ?", stat%)
rx$ = Space$(255)
Call enter(rx$, 255, Rl%, intAddress2400dx, stat%)
'Call send(intAddress2400dx, ":ARM:COUNT INF", stat%)
'Call send(intAddress2400dx, ":INIT", stat%)
'Delay (6000)
'Call send(intAddress2400dx, ":ABORT", stat%)
'Call send(intAddress2400dx, ":ARM:COUNT 1", stat%)
'Call send(intAddress2400dx, ":TRIG:COUNT 1", stat%)
'Call send(intAddress2400dx, ":TRIG:SOURCE IMM", stat%)
'Call send(intAddress2400dx, ":TRIG:DELAY 0", stat%)
'Call send(intAddress2400dx, ":OUTPUT ON", stat%)
Call send(intAddress2400dx, ":READ?", stat%)
rx$ = Space$(255)
Call enter(rx$, 255, Rl%, intAddress2400dx, stat%)
rx$ = Trim$(rx$)
For i% = Len(rx$) To 1 Step -1
    If Mid$(rx$, i%, 1) = "," Then
        rx$ = Mid$(rx$, i% + 1)
        Exit For
    End If
Next i%
lblres = rx$
theval! = Val(rx$)
'Call ReadResCont(theval! * 2, 6, 1) 'riporto in continua lo strumento
bytInit = 0
End Sub
Sub ReadResInTensione(theval!, rnom!, theValOhm!)

If bytInit = 0 Then
   Call initsystem(1, 0, 1, 1, 1)
End If

Call send(intAddress2400dx, ":ABORT", stat%)
PowLimit! = PowerTrim
Call send(intAddress2400dx, ":SENS:FUNC 'VOLT:DC'", stat%) ' Sense Voltage
Call send(intAddress2400dx, ":SENS:VOLT:NPLC 0.01", stat%)    ' Integration rate Influrnza la velocita'
'Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 21", stat%) ' Voltage Compliance
Call send(intAddress2400dx, ":SOUR:FUNC CURR", stat%)   ' Source Current
If rnom! > 0 Then
    iset! = Sqr(PowLimit! / rnom!)   ' Valore della Corrente di taratura
    If iset! > 1 Then iset! = 1
    vset! = Sqr(PowLimit! * rnom!)
  '  If vset! > 100 Then
   '     vset! = 100
   '     iset! = 100 / rnom!
  '  End If
End If
Select Case vset!
Case Is < 2
    Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV " + Str(2.1), stat%)
    Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 2", stat%)
    
Case 2 To 20
    Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV " + Str(21), stat%)
    Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 20", stat%)
   
Case 20 To 60
    Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV " + Str(70), stat%)
    Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 60", stat%)
Case Is > 60
    Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV " + Str(200), stat%)
    Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 200", stat%)
    
End Select


'Call send(intAddress2400dx, ":TRIG:CLE", stat%)
Call send(intAddress2400dx, ":SOUR:CURR:IMM" + Str(iset!), stat%) ' Source Current IMMediate 1 mA
Call send(intAddress2400dx, ":SOUR:DEL 0", stat%)   ' Source Delay 1 mS
Call send(intAddress2400dx, ":ARM:COUNT 1", stat%)
Call send(intAddress2400dx, ":TRIG:COUNT 1", stat%)
Call send(intAddress2400dx, ":TRIG:SOURCE IMM", stat%)
Call send(intAddress2400dx, ":TRIG:DELAY 0", stat%)
Call send(intAddress2400dx, ":OUTP ON", stat%)
Delay (100)
Call send(intAddress2400dx, ":READ?", stat%)
rx$ = Space$(255)
Call enter(rx$, 255, Rl%, intAddress2400dx, stat%)
Call send(intAddress2400dx, ":READ?", stat%)
rx$ = Space$(255)
Call enter(rx$, 255, Rl%, intAddress2400dx, stat%)
theval! = Val(rx$)
Call send(intAddress2400dx, ":SOUR:CURR?", stat%)
rx$ = Space$(255)
Call enter(rx$, 255, Rl%, intAddress2400dx, stat%)
iset! = Val(rx$)
If iset! <> 0 Then theValOhm! = theval! / iset!




End Sub




Sub Inizializza2400PerLetturaResistenza()

bytTipoLetturaCorrente = 2
'''mario''' Call send(intAddress2400dx, "*RST", stat%)
Call send(intAddress2400dx, "*CLS", stat%)
Call send(intAddress2400dx, ":SYST:FRSW REAR", stat%) ' puntali posteriori
Call send(intAddress2400dx, ":SYST:RSEN ON", stat%) 'abilita la misura a 4 puntali
Call send(intAddress2400dx, ":FORM:ELEM RES", stat%) 'legge solo tensioni
Call send(intAddress2400dx, ":DISP:DIG 6", stat%)
Call send(intAddress2400dx, ":SENS:FUNC 'RES'", stat%) ' Sense Voltage
Call send(intAddress2400dx, ":SENS:RES:NPLC 0.01", stat%)    ' Integration rate Influrnza la velocita'
Call send(intAddress2400dx, ":SENS:RES:RANGE:AUTO 1", stat%)

Call send(intAddress2400dx, ":ARM:COUNT 1", stat%)
Call send(intAddress2400dx, ":TRIG:COUNT 1", stat%)

End Sub

Sub ReadRes(theval!)

If bytTipoLetturaCorrente <> 2 Then Call Inizializza2400PerLetturaResistenza
Call send(intAddress2400dx, ":ABOR", stat%)
Call send(intAddress2400dx, ":SENS:RES:RANGE:AUTO 1", stat%)
Call send(intAddress2400dx, ":SENS:AVER:STAT OFF", stat%)
Call send(intAddress2400dx, ":MEAS:RES?", stat%)
rx$ = Space$(255)
Call enter(rx$, 255, Rl%, intAddress2400dx, stat%)
theval! = Val(rx$)

Call send(intAddress2400dx, ":ARM:COUN INF", stat%)
'Call send(intAddress2400dx, ":OUTPUT ON", stat%)
Call send(intAddress2400dx, ":INIT", stat%)

End Sub

Sub ReadResCont(sngRangeRes As Long, intDigit As Integer, bytAbilitazioneUscita As Byte)
'lettura in continua della resistenza

Call initsystem(1, 0, 1, 1, 1)
Call send(intAddress2400dx, ":FORM:ELEM RES", stat%)     ' legge solo la resistenza
Call send(intAddress2400dx, ":SENS:FUNC 'RES'", stat%)
Call send(intAddress2400dx, ":ARM:COUNT INF", stat%)
If sngRangeRes = 0 Then
   Call send(intAddress2400dx, ":SENS:RES:RANGE:AUTO 1", stat%)
Else
   Call send(intAddress2400dx, ":SENS:RES:RANGE " + Str(sngRangeRes), stat%)
End If
If intDigit = 0 Then
   Call send(intAddress2400dx, ":DISP:DIG 5", stat%)
Else
   Call send(intAddress2400dx, ":DISP:DIG " + Str(intDigit), stat%)
End If
If bytAbilitazioneUscita = 1 Then
   Call send(intAddress2400dx, ":OUTPUT ON", stat%)
   Call send(intAddress2400dx, ":INIT", stat%)
Else
   Call send(intAddress2400dx, ":OUTPUT OFF", stat%)
End If

End Sub



Sub testgpib()
'Exit Sub
'Controlla se la scheda gpib e' presente
'e inizializza il bus
aa% = GpibBoardPresent
If aa% <> 1 Then
    MsgBox ("No GPIB Board found!")
    Exit Sub
End If
Call initialize(21, 0)
aa% = GPIBFeature(IEEEListener)
If aa% <> 0 And ListenerPresent(a27%) Then
    MsgBox ("Device not found!")
    Exit Sub
End If
add1$ = ""
If intAddress2400dx <> 0 Then
    add1$ = "LISTEN " + Trim$(Str$(intAddress2400dx)) + " "
End If
add2$ = ""
If Scanad% <> 0 Then
    add2$ = "LISTEN " + Trim$(Str$(Scanad%)) + " "
End If
add3$ = ""
If a27% <> 0 Then
    add3$ = "LISTEN " + Trim$(Str$(a27%)) + " "
End If
add4$ = ""
If a23% <> 0 Then
    add4$ = "LISTEN " + Trim$(Str$(a23%)) + " "
End If
Call transmit("UNT UNL MTA " + add1$ + add2$ + add3$ + add4$ + "REN SDC UNL UNT", st%)
If intAddress2400dx <> 0 Then
    Call send(intAddress2400dx, "*RST", stat%)
End If
If Scanad% <> 0 Then
    Call openscan
End If
'If a27% <> 0 Then
 '   Call send(a27%, "*RST", stat%)
  '  Call oscan2700
'End If
'If a23% <> 0 Then
 '   Call send(a23%, "SDC", stat%)
'End If
End Sub

Sub closescan(sch%, scl%, scg%)
scancmd$ = ""
If sch% > 0 Then
    If sch% = scl% Then
                erf% = 1
    End If
    If sch% = scg% Then
                erf% = erf% + 2
    End If
End If
If scl% > 0 Then
    If scl% = scg% Then
                erf% = erf% + 4
    End If
End If
If erf% > 0 Then
    If (erf% And 1) = 1 Then sch% = -1: scl% = -1
    If (erf% And 2) = 2 Then sch% = -1: scg% = -1
    If (erf% And 4) = 4 Then scl% = -1: scg% = -1
    Exit Sub
End If
If Scanad% > 0 And (sch% > 0 Or scl% > 0 Or scg% > 0) Then
        If sch% > 0 Then
            Call checkscan(1, sch%, cd%, bk%)
            If cd% > 0 Then
                scancmd$ = Trim$(Str$(cd%)) + "!" + Trim$(Str$(bk%)) + ","
            Else
                sch% = -1
            End If
        End If
        If scl% > 0 Then
            Call checkscan(2, scl%, cd%, bk%)
            If cd% > 0 Then
                scancmd$ = scancmd$ + Trim$(Str$(cd%)) + "!" + Trim$(Str$(bk%)) + ","
            Else
                scl% = -1
            End If
        End If
        If scg% > 0 Then
            Call checkscan(3, scg%, cd%, bk%)
            If cd% > 0 Then
                scancmd$ = scancmd$ + Trim$(Str$(cd%)) + "!" + Trim$(Str$(bk%)) + ","
            Else
                scg% = -1
            End If
        End If
        If scancmd$ <> "" Then
            Call readdevice(0, 0, 5)
            If d0.O_System_On = 1 Then
                scancmd$ = Left$(scancmd$, Len(scancmd$) - 1)
                Call openscan
                Call send(Scanad%, ":close (@ " + scancmd$ + ")", stat%)
            End If
        End If
End If
If scg% > 0 Then
    theguard% = 1
Else
    theguard% = 0
End If
End Sub
Sub openscan()
If Scanad% > 0 Then
        Call send(Scanad%, ":open ALL", stat%)
End If
End Sub

Sub trimr(rnom1!, rnom2!, percentage!, timout%, intDigit As Integer)
   'taglio a stop singolo o doppio
   'se singolo su OUT 0
   'se doppio prima Out 1 poi Out 0
   dcut% = 0
   PowLimit! = PowerTrim '0.01
   If rnom1! = 0 Then
        MsgBox ("Impossible with null resistor values!")
        Exit Sub
   End If
   If (rnom2! <> 0) And (rnom2! > rnom1!) Then
        dcut% = 1
   Else
        rnom2! = 0
   End If
   'pretest su tolleranza accettazione
'   Call ReadResOld(theval!, guard%)
   thenom! = rnom1!
   If rnom2! > 0 Then thenom! = rnom2!
   If bytInit = 0 Then Call initsystem(1, 0, 1, 1, 1)
'   Call initsystem(1, 0, 1, 1, 1)
   If intDigit = 0 Then
      Call send(intAddress2400dx, ":DISP:DIG 7", stat%)
   Else
      Call send(intAddress2400dx, ":DISP:DIG " + Str(intDigit), stat%)
   End If
   Call send(intAddress2400dx, ":SENS:FUNC 'VOLT:DC'", stat%) ' Sense Voltage
   Call send(intAddress2400dx, ":SENS:VOLT:NPLC 0.01", stat%)    ' Integration rate Influrnza la velocita'
   'Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 200", stat%)
   Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 200", stat%) ' Voltage Compliance
   Call send(intAddress2400dx, ":SOUR:FUNC CURR", stat%)   ' Source Current
   If rnom2! > 0 Then
        iset! = Sqr(PowLimit! / rnom2!)    ' Valore della Corrente di taratura
        If iset! > 1 Then iset! = 1
        vset2! = Sqr(PowLimit! * rnom2!)
      '  If vset2! > 100 Then
       '     vset2! = 100
        '    iset! = 100 / rnom2!
   '     End If
        vset1! = rnom1! * iset!
   Else
        iset! = Sqr(PowLimit! / rnom1!)
        If iset! > 1 Then iset! = 1
        vset1! = iset! * rnom1!
    '    If vset1! > 100 Then
     '       vset1! = 100
      '      iset! = 100 / rnom1!
       ' End If
   End If
   If dcut% = 0 Then
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vset1!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
        Select Case vset1!
        Case Is < 2
             Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 4", stat%)
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 2", stat%)
        Case 2 To 20
             Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 30", stat%)
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 20", stat%)
        Case 20 To 60
             Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 70", stat%)
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 60", stat%)
        Case Is > 60
             Call send(intAddress2400dx, ":SENS:VOLT:PROT:LEV 200", stat%)
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 200", stat%)
        End Select
   Else
        Call send(intAddress2400dx, ":CALC2:LIM2:UPP" + Str(vset1!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM2:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM2:UPP:SOUR2 14", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP" + Str(vset2!), stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:LOW -20", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:UPP:SOUR2 13", stat%)
        Select Case vset2!
        Case Is < 2
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 2", stat%)
        Case 2 To 20
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 20", stat%)
        Case Is > 20
             Call send(intAddress2400dx, ":SENS:VOLT:DC:RANGE 200", stat%)
        End Select
   End If
   Call send(intAddress2400dx, ":SOUR:CURR:IMM" + Str(iset!), stat%) ' Source Current IMMediate 1 mA
   Call send(intAddress2400dx, ":SOUR:DEL 0.001", stat%)   ' Source Delay 1 mS
   Call send(intAddress2400dx, ":CALC2:FEED VOLT", stat%)
   Call send(intAddress2400dx, ":CALC2:CLIM:PASS:SOUR2 15", stat%)
   Call send(intAddress2400dx, ":CALC2:CLIM:BCON IMM", stat%)
   Call send(intAddress2400dx, ":TRIG:DELAY 0.001", stat%)
   Call send(intAddress2400dx, ":TRIG:COUNT 1", stat%)
   Call send(intAddress2400dx, ":ARM:COUN INF", stat%)   ' ARM
   Call send(intAddress2400dx, ":STAT:QUE:CLEAR", stat%)    '
   Call send(intAddress2400dx, ":STAT:PRES", stat%)    ' Status preset
   Call send(intAddress2400dx, "*SRE 1", stat%)    ' SRQ
   Call send(intAddress2400dx, "*CLS", stat%)       ' reset Status Byte Register  per SRQ
   Call send(intAddress2400dx, ":CALC2:LIM1:STAT 0", stat%)
   If dcut% = 1 Then
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 1", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 0", stat%)
        Call send(intAddress2400dx, ":STAT:MEAS:ENAB 4", stat%)    ' Limit 2  FAIL
   Else
        Call send(intAddress2400dx, ":CALC2:LIM2:STAT 0", stat%)
        Call send(intAddress2400dx, ":CALC2:LIM3:STAT 1", stat%)
        Call send(intAddress2400dx, ":STAT:MEAS:ENAB 16", stat%)    ' Limit 3  FAIL
   End If
   Call send(intAddress2400dx, ":OUTPUT ON", stat%)
   Call send(intAddress2400dx, ":INIT", stat%)
   
End Sub
