Attribute VB_Name = "PowerSupply"
Option Explicit
Private UsePowerSupply As Boolean
Private PowerComm As MSComm    ' Create object variable.

Public Sub SetPowerComm(Comm As MSComm)
    Set PowerComm = Comm ' Get reference to MSComm control
End Sub

Public Function ConfigurePowerSupply(Port As Integer, ErrStr As String)
    Dim ResponseString As String
    
    If Port = 0 Then
        UsePowerSupply = False
        ErrStr = ""
        ConfigurePowerSupply = True
        Exit Function
    Else
        UsePowerSupply = True
    End If
     
    ' Use COM1.
    PowerComm.CommPort = Port
    ' 9600 baud, no parity, 8 data, and 2 stop bits.
    PowerComm.Settings = "9600,N,8,2"
    ' Tell the control to read all that is available
    PowerComm.InputLen = 0
    ' Open the port.
    PowerComm.PortOpen = True

    ' reset the power supply clear all errors and set it for remote use
    If Not ResetSupply(ResponseString) Then
        ErrStr = ResponseString
        GoTo ErrorExit
    End If
   
   ' make sure that an Agilent power suplly is out there
    If Not CheckId(ResponseString) Then
        ErrStr = ResponseString
        GoTo ErrorExit
    End If
   
   ' set up the +25 volt channel for 12 volt out put with a 1 amp curren limit
    If Not SetP25V_Channel(ResponseString) Then
        ErrStr = ResponseString
        GoTo ErrorExit
    End If
   
    ErrStr = ""
    ConfigurePowerSupply = True
    Exit Function

ErrorExit:
    ConfigurePowerSupply = False

End Function

Public Function PowerOn(ErrStr As String)
    
    If UsePowerSupply = False Then
        ErrStr = ""
        PowerOn = True
        Exit Function
    End If
    
    'Configure the power supply for the shutter test
    ErrStr = SendCommand("OUTP ON")
    
    If Val(ErrStr) = 0 Then
        PowerOn = True
        Exit Function
    End If
        
    PowerOn = False
End Function

Public Function PowerOff(ErrStr As String)
    
    If UsePowerSupply = False Then
        ErrStr = ""
        PowerOff = True
        Exit Function
    End If
    
    'Configure the power supply for the shutter test
    ErrStr = SendCommand("OUTP OFF")
    
    If Val(ErrStr) = 0 Then
        PowerOff = True
        Exit Function
    End If
        
    PowerOff = False
End Function

Private Function ResetSupply(ErrStr As String)
    'This command must be sent solo for some unknown reason
    'so no SendCommand here
    PowerComm.Output = "SYST:REM" & vbCrLf
    Sleep 200
    'Reset the power supply and clear all settings
    ErrStr = SendCommand("*RST;*CLS")
        
    If Val(ErrStr) = 0 Then
        ResetSupply = True
        Exit Function
    End If
        
    ResetSupply = False
End Function

Private Function CheckId(ErrStr As String)
    'Query the identity
    ErrStr = SendRequest("*IDN?")
    
    If StrComp(Left(ErrStr, 15), "HEWLETT-PACKARD") Then
        ErrStr = "Bad ID: " & ErrStr
        CheckId = False
        Exit Function
    End If

    CheckId = True
End Function

Private Function SetP25V_Channel(ErrStr As String)
    
    'Configure the power supply for the shutter test
    ErrStr = SendCommand("APPL P25V, 12.0, 1.0")
    
    If Val(ErrStr) = 0 Then
        SetP25V_Channel = True
        Exit Function
    End If
        
    SetP25V_Channel = False
End Function

Private Function SendCommand(Cmd As String)
    Dim ErrorString As String
    Dim TimeOut As Long
    
    'Set TimeOut variable for 2.0 seconds
    TimeOut = AppTickCount + 20
    
    Cmd = Cmd & ";SYST:ERR?" & vbCrLf
    ErrorString = ""
    PowerComm.Output = Cmd
    
    ' grab chars until you hit a line feed or you time out
    Do Until Right(ErrorString, 2) = vbCrLf
        ErrorString = ErrorString & PowerComm.Input
        DoEvents
        If AppTickCount > TimeOut Then
            SendCommand = "-1 Timed out waiting for power supply"
            Exit Function
        End If
    Loop
    
    SendCommand = ErrorString
    
End Function

Private Function SendRequest(Request As String)
    Dim ReplyString As String
    Dim TimeOut As Long
    
    'Set TimeOut variable for 2.0 seconds
    TimeOut = AppTickCount + 20
    
    Request = Request & vbCrLf
    ReplyString = ""
    PowerComm.Output = Request
    
    ' grab chars until you hit a line feed or you time out
    Do Until Right(ReplyString, 2) = vbCrLf
        ReplyString = ReplyString & PowerComm.Input
        DoEvents
        If AppTickCount > TimeOut Then
            SendRequest = "-1 Timed out waiting for response"
            Exit Function
        End If
    Loop
    
    SendRequest = ReplyString
    
End Function