sicl4.bas

通过GPIB接口读取频谱仪的测试曲线

End Function


Function igettermchr(ByVal id1 As Integer, tchr As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_igettermchr(id1, tchr)
    igettermchr = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function


Function ivprintf(ByVal id1 As Integer, ByVal fmt As String, Optional ByVal ap As Variant) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer
    Dim howLong As Long

    ' Force no error to be condition
    Call vb_icauseerr(id1, 0, 0)

    
    If VarType(ap) = 8 Then
       howLong = Len(ap)
#If Win16 Then
       If howLong > 32767 Then
          Err.Clear
          myerrstr = "Third param string length must be <= 32767"
          Err.Description = myerrstr
          MsgBox myerrstr
          Err.Raise (I_ERR_PARAM) 'Raise the error
       End If
#End If
    Else
       howLong = 0
    End If
      
    ' Call the function in the SICL DLL and check for errors
    If IsMissing(ap) Then
       id = vb_ivprintf(ByVal id1, ByVal fmt, ByVal sEmpty, ByVal howLong)
    ElseIf IsEmpty(ap) Then
       id = vb_ivprintf(ByVal id1, ByVal fmt, ByVal sEmpty, ByVal howLong)
    Else
       id = vb_ivprintf(ByVal id1, ByVal fmt, ByVal ap, ByVal howLong)
    End If
    
    ivprintf = id

    thisErrno = vb_igeterrno()
    If thisErrno <> 0 Then
        Err.Clear    ' set default values in the error object
        ' set the error string and raise the error
        tmp = vb_igeterrstr(thisErrno, myerrstr)
        Err.Description = myerrstr
        Err.Raise (thisErrno) 'Raise the error
    End If

End Function


Function ivscanf(ByVal id1 As Integer, ByVal fmt As String, ByRef myVal As Variant) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim howLong As Long
    Dim myerrstr As String * 60
    Dim tmp As Integer
    Dim returnStr As String
        
    ' Put anything in the local string to make non-null
    returnStr = "aa"
                   
    ' Force no error to be condition
    Call vb_icauseerr(id1, 0, 0)

    tmp = VarType(myVal)

    If VarType(myVal) = 8 Then
       howLong = Len(myVal)
#If Win16 Then
       If howLong > 32767 Then
          Err.Clear
          myerrstr = "Third param string length must be <= 32767"
          Err.Description = myerrstr
          MsgBox myerrstr
          Err.Raise (I_ERR_PARAM) 'Raise the error
       End If
#End If
    Else
       howLong = 0
    End If

    ' Call the function in the SICL DLL and check for errors
    If tmp = 8 Then
       id = vb_ivscanf(id1, fmt, returnStr, howLong)

       'Place scanf value into myVal
       myVal = returnStr
    Else
       id = vb_ivscanf(id1, fmt, myVal, howLong)
    End If

        
    ivscanf = id
        
    thisErrno = vb_igeterrno()
    If thisErrno <> 0 Then
        myerrstr = ""
        Err.Clear    ' set default values in the error object
        ' set the error string and raise the error
        tmp = vb_igeterrstr(thisErrno, myerrstr)
        Err.Description = myerrstr
        MsgBox myerrstr
        Err.Raise (thisErrno) 'Raise the error
    End If

End Function


Function iflush(ByVal id1 As Integer, ByVal mask As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_iflush(id1, mask)
    iflush = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function



Function isetbuf(ByVal id1 As Integer, ByVal mask As Integer, ByVal size As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_isetbuf(id1, mask, size)
    isetbuf = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function



Function iclear(ByVal id1 As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_iclear(id1)
    iclear = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function

Function ilocal(ByVal id1 As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_ilocal(id1)
    ilocal = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function



Function iremote(ByVal id1 As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_iremote(id1)
    iremote = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function



Function ireadstb(ByVal id1 As Integer, ByRef stb As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_ireadstb(id1, stb)
    ireadstb = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function



Function itrigger(ByVal id1 As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_itrigger(id1)
    itrigger = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function



Function ixtrig(ByVal id1 As Integer, ByVal which As Long) As Integer
    Dim id As Integer
    Dim thisErrno As Integer
    Dim myerrstr As String * 60
    Dim tmp As Integer

    ' Call the function in the SICL DLL and check for errors
    id = vb_ixtrig(id1, which)
    ixtrig = id
    If id <> 0 Then
        thisErrno = vb_igeterrno()
        If thisErrno <> 0 Then
            Err.Clear    ' set default values in the error object
            ' set the error string and raise the error
            tmp = vb_igeterrstr(thisErrno, myerrstr)
            Err.Description = myerrstr
            Err.Raise (thisErrno) 'Raise the error
        End If
    End If

End Function


Function ihint(ByVal id1 As Integer, ByVal hint As Integer) As Integer
    Dim id As Integer
    Dim thisErrno As Integer