VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmGetScreenImage 
   Caption         =   "Get Instrument Display"
   ClientHeight    =   9945
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   10380
   Icon            =   "GetScreenImage.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   9945
   ScaleWidth      =   10380
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame4 
      Caption         =   "Instrument Connection"
      Height          =   1215
      Left            =   120
      TabIndex        =   13
      Top             =   120
      Width           =   5415
      Begin VB.CommandButton cmdDisconnect 
         Caption         =   "&Disconnect"
         Height          =   375
         Left            =   4080
         TabIndex        =   19
         ToolTipText     =   "Disconnect from currently connected instrument"
         Top             =   720
         Width           =   1215
      End
      Begin VB.CommandButton cmdConnect 
         Caption         =   "&Connect"
         Height          =   375
         Left            =   4080
         TabIndex        =   18
         ToolTipText     =   "Connect to instrument at Instrument Address"
         Top             =   240
         Width           =   1215
      End
      Begin VB.TextBox txtAddress 
         Alignment       =   2  'Center
         Height          =   315
         Left            =   2040
         TabIndex        =   16
         Text            =   "GPIB0::17::INSTR"
         ToolTipText     =   "Hardware address of instrument which to connect"
         Top             =   360
         Width           =   1815
      End
      Begin VB.Label lblStatus 
         Alignment       =   2  'Center
         BackColor       =   &H000000FF&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Not Connected"
         Height          =   255
         Left            =   2040
         TabIndex        =   17
         ToolTipText     =   "Status of the instrument connection"
         Top             =   840
         Width           =   1815
      End
      Begin VB.Label lblInstStatus 
         Caption         =   "Connection Status:"
         Height          =   255
         Left            =   240
         TabIndex        =   15
         Top             =   840
         Width           =   1455
      End
      Begin VB.Label lblAddress 
         Caption         =   "Instrument &Address:"
         Height          =   255
         Left            =   240
         TabIndex        =   14
         Top             =   360
         Width           =   1455
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "Instrument Display Capture"
      Height          =   1215
      Left            =   5640
      TabIndex        =   8
      Top             =   120
      Width           =   4335
      Begin VB.CommandButton cmdFreeze 
         Caption         =   "&Freeze"
         Height          =   375
         Left            =   120
         TabIndex        =   12
         ToolTipText     =   "Freeze the current image"
         Top             =   720
         Width           =   1215
      End
      Begin VB.TextBox txtInterval 
         Alignment       =   2  'Center
         Height          =   285
         Left            =   3720
         TabIndex        =   11
         Text            =   "5"
         ToolTipText     =   "The number of seconds at which to capture the instrument display"
         Top             =   360
         Width           =   495
      End
      Begin VB.CommandButton cmdCaptureDisplay 
         Caption         =   "Ca&pture"
         Height          =   375
         Left            =   120
         TabIndex        =   9
         ToolTipText     =   "Begin capturing images from the instrument display"
         Top             =   240
         Width           =   1215
      End
      Begin VB.Label lblIStatus 
         Alignment       =   2  'Center
         BackColor       =   &H00FFFF00&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Stopped"
         Height          =   255
         Left            =   2880
         TabIndex        =   21
         ToolTipText     =   "Status of image operation"
         Top             =   840
         Width           =   1335
      End
      Begin VB.Label lblImageStatus 
         Caption         =   "Image Status:"
         Height          =   255
         Left            =   1560
         TabIndex        =   20
         Top             =   840
         Width           =   1455
      End
      Begin VB.Label lblInterval 
         Caption         =   "Cap&ture Interval (secs):"
         Height          =   255
         Left            =   1560
         TabIndex        =   10
         Top             =   360
         Width           =   2055
      End
   End
   Begin VB.Timer Timer1 
      Left            =   840
      Top             =   2760
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   240
      Top             =   2760
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
   End
   Begin VB.Frame Frame2 
      Caption         =   "Current Image Information"
      Height          =   855
      Left            =   5640
      TabIndex        =   5
      Top             =   1440
      Width           =   4335
      Begin VB.Label lblInstTimestamp 
         AutoSize        =   -1  'True
         Caption         =   "Image Timestamp"
         Height          =   195
         Left            =   1560
         TabIndex        =   7
         Top             =   240
         Width           =   1245
      End
      Begin VB.Label lblTimestamp 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   360
         TabIndex        =   6
         ToolTipText     =   "The timestamp of the image taken from the instrument"
         Top             =   480
         Width           =   3615
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Current Connection Information"
      Height          =   855
      Left            =   120
      TabIndex        =   0
      Top             =   1440
      Width           =   5415
      Begin VB.Label lblModel 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   240
         TabIndex        =   4
         ToolTipText     =   "The model and firmware version of the currently connected instrument"
         Top             =   480
         Width           =   2775
      End
      Begin VB.Label lblInstModel 
         Alignment       =   2  'Center
         Caption         =   "Model"
         Height          =   255
         Left            =   840
         TabIndex        =   3
         Top             =   240
         Width           =   1695
      End
      Begin VB.Label lblVersion 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   3360
         TabIndex        =   2
         ToolTipText     =   "The active channel of the currently connected instrument"
         Top             =   480
         Width           =   1815
      End
      Begin VB.Label lblInstFirmware 
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         Caption         =   "Firmware Version"
         Height          =   195
         Left            =   3660
         TabIndex        =   1
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   10320
      Y1              =   0
      Y2              =   0
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   7335
      Left            =   120
      Top             =   2400
      Width           =   9855
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "&About"
      Begin VB.Menu mnuAutomationServer 
         Caption         =   "Automation Server"
      End
      Begin VB.Menu mnuDisclaimer 
         Caption         =   "Disclaimer"
      End
   End
   Begin VB.Menu mnuInstrument 
      Caption         =   "&Instrument Display"
      Begin VB.Menu mnuCapture 
         Caption         =   "Capture Single Image"
      End
      Begin VB.Menu mnuSave_Display 
         Caption         =   "Save Single Image to File"
      End
   End
   Begin VB.Menu mnuImage 
      Caption         =   "C&urrent Image"
      Begin VB.Menu mnuCopyToClipboard 
         Caption         =   "Copy to Clipboard"
      End
      Begin VB.Menu mnuSave_Image 
         Caption         =   "Save to File"
      End
      Begin VB.Menu mnuPrint 
         Caption         =   "Print"
      End
   End
   Begin VB.Menu mnuQuit 
      Caption         =   "&Quit"
   End
End
Attribute VB_Name = "frmGetScreenImage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'  Copyright © 2003 Agilent Technologies Inc.  All rights reserved.
'
' You have a royalty-free right to use, modify, reproduce and distribute
' the Sample Application Files (and/or any modified version) in any way
' you find useful, provided that you agree that Agilent has no
' warranty,  obligations or liability for any Sample Application Files.
'
' Agilent provides programming examples for illustration only,
' This sample program assumes that you are familiar with the programming
' language being demonstrated and the tools used to create and debug
' procedures. Agilent support engineers can help explain the
' functionality of Agilent software components and associated
' commands, but they will not modify these samples to provide added
' functionality or construct procedures to meet your specific needs.
' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Option Explicit

Dim Agt4395 As New AgtServer4395            'a new instance of the Agt4395 automation server

Private Sub cmdCaptureDisplay_Click()
    'The timer handles the call to actually capture the instrument display
    Timer1.Enabled = True
    
    'overhead tasks
    cmdCaptureDisplay.Enabled = False
    cmdFreeze.Enabled = True
    lblIStatus.Caption = "Capturing"
    mnuInstrument.Enabled = False
    txtInterval.Enabled = False
  
End Sub

Private Sub cmdConnect_Click()
On Error GoTo CaptureError
    Dim szInstrumentModel As String     'variable to hold instrument model string
    Dim szInstrumentVersion As String   'variable to hold instrument firmware version string
    Dim szConnName As String            'variable to hold instrument address string
    
    If txtAddress.Text = "" Then 'there is an address in the address field
        MsgBox "You must enter an address in the Instrument Address field.", _
            vbOKOnly + vbExclamation, "No Address"
        GoTo End_Connect
    End If 'txtAddress.Text = ""
    
    frmGetScreenImage.MousePointer = vbHourglass
    
    'The following demonstrates how to connect to the instrument at the given address
    Agt4395.Connect txtAddress.Text
        
    'If the connection was made, communicate with the instrument
    If (Agt4395.ConnectedStatus) Then 'a connection to an instrument was made
        
        'The following is an example of how to get instrument characteristics
        szInstrumentModel = Agt4395.Utilities.InstrumentModel
        szInstrumentVersion = Agt4395.Utilities.InstrumentFirmwareVersion
        szConnName = Agt4395.ConnectionName

        If SupportedModel Then 'instrument is a supported Agt4395
            'The following is an example of how to send SCPI commands to the instrument
            Dim szReply As String           'variable to hold string returned from instrument
            Agt4395.Output "*idn?"
            Agt4395.Enter szReply
            MsgBox "Connected to " & szReply, vbInformation, "Connection"
                
            'Overhead tasks
            cmdConnect.Enabled = False
            cmdDisconnect.Enabled = True
            cmdCaptureDisplay.Enabled = True
            mnuInstrument.Enabled = True
            txtAddress.Enabled = False
            txtInterval.Enabled = True
                        
            lblModel.Caption = szInstrumentModel
            lblVersion.Caption = szInstrumentVersion
            lblStatus.Caption = "Connected"
            lblStatus.BackColor = &HFF00&   'green
        
        Else 'instrument is not a supported model
            MsgBox "Instrument " & szInstrumentModel & " at address " & szConnName & _
                " is not a supported instrument.", vbExclamation, "Instrument Not Supported"
            Call cmdDisconnect_Click
            GoTo End_Connect
        End If 'SupportedModel
    
    Else 'no instrument connection was made
        MsgBox "Could not connect to specified address!", _
            vbOKOnly + vbExclamation, "Connection"
    End If '(Agt4395.ConnectedStatus)
    
End_Connect:
    frmGetScreenImage.MousePointer = vbDefault
    Exit Sub

CaptureError:
    Dim szErrstring As String           'variable to hold error string
    
    frmGetScreenImage.MousePointer = vbDefault
    szErrstring = Err.Description
    MsgBox "Connect failed" & vbCrLf & "Error Details:" & vbCrLf & szErrstring, _
        vbCritical, "Connect Error"
   
End Sub

Private Sub cmdDisconnect_Click()
On Error GoTo CaptureError
    'The following demonstrates a way to disconnect from the connected instrument
    Agt4395.Close
            
    If (Agt4395.ConnectedStatus) Then 'instrument is still connected
        MsgBox "Could not disconnect from instrument!", _
            vbOKOnly + vbExclamation, "Disconnect Error"
    
    Else 'instrument is no longer connected
        'Overhead tasks
        cmdCaptureDisplay.Enabled = False
        cmdConnect.Enabled = True
        cmdDisconnect.Enabled = False
        cmdFreeze.Enabled = False
        lblIStatus.Caption = "Stopped"
        lblModel.Caption = ""
        lblInstFirmware.Caption = ""
        lblStatus.BackColor = &HFF&     'red
        lblStatus.Caption = "Not Connected"
        txtAddress.Enabled = True
        txtInterval.Enabled = True
        mnuInstrument.Enabled = False
    End If '(Agt4395.ConnectedStatus)
    
    Exit Sub

CaptureError:
    Dim szErrstring As String           'variable to hold error string
    
    frmGetScreenImage.MousePointer = vbDefault
    szErrstring = Err.Description
    MsgBox "Disconnect failed" & vbCrLf & "Error Details:" & vbCrLf & szErrstring, _
        vbCritical, "Disconnect Error"

End Sub

Private Sub GetScreenImage()
On Error GoTo CaptureError
    Dim g_picScreenShot As Picture          'variable to hold screenshot
    Dim szCurrentInstrumentDate As String   'variable to hold date string returned by instrument
    Dim szCurrentInstrumentTime As String   'variable to hold time string returned by instrument
    
    frmGetScreenImage.MousePointer = vbHourglass
    
    'The following demonstrates how to get the time and date from the instrument
    szCurrentInstrumentDate = Date
    szCurrentInstrumentTime = Time
    
    'The following demonstrates how to get an image of the instrument's front panel display
    
    If Agt4395.Utilities.InstrumentModel = "4294A" Then
        Agt4395.Output "PRIC VARI;*WAI"      'image color
        'Agt4395.Output "PRIC FIXE;*WAI"     'fixed color
        'Agt4395.Output "PRIC STAN;*WAI"     'black&white
    Else '4395A/4396B
        Agt4395.Output "PRIC;PRICVARI;*WAI"  'image color
        'Agt4395.Output "PRIC;PRICFIXE;*WAI" 'fixed color
        'Agt4395.Output "PRIS;*WAI"          'black&white
    End If
    
    Set g_picScreenShot = Agt4395.GetScreenImage
    Set Image1.Picture = g_picScreenShot
    
    lblTimestamp.Caption = szCurrentInstrumentTime & "   " & szCurrentInstrumentDate
        
    If Not (mnuImage.Enabled) Then 'image menu item is disabled
        mnuImage.Enabled = True
    End If 'Not (mnuImage.Enabled)
    
    frmGetScreenImage.MousePointer = vbDefault
    Exit Sub

CaptureError:
    Dim szErrstring As String               'variable to hold error string
    
    frmGetScreenImage.MousePointer = vbDefault
    szErrstring = Err.Description
    
    MsgBox "Get Screen Image failed" & vbCrLf & "Error Details:" & vbCrLf & _
            szErrstring, vbCritical, "Get Screen Image Error"
    
End Sub

Private Sub cmdFreeze_Click()
    'stop the timer so that no more images are captured
    Timer1.Enabled = False
    
    'overhead tasks
    cmdCaptureDisplay.Enabled = True
    cmdFreeze.Enabled = False
    lblIStatus.Caption = "Stopped"
    mnuInstrument.Enabled = True
    txtInterval.Enabled = True
End Sub

Private Sub Form_Load()
    'Overhead tasks
    cmdCaptureDisplay.Enabled = False
    cmdConnect.Enabled = True
    cmdDisconnect.Enabled = False
    cmdFreeze.Enabled = False
    lblVersion.Caption = ""
    lblIStatus.Caption = "Stopped"
    lblModel.Caption = ""
    lblTimestamp.Caption = ""
    mnuInstrument.Enabled = False
    mnuImage.Enabled = False
    mnuQuit.Enabled = True
    txtAddress.Enabled = True
    
    'Make sure the timer is disabled at start, but set the interval
    Timer1.Enabled = False
    Timer1.Interval = CLng(txtInterval.Text) * 1000
    
End Sub

Function SupportedModel() As Boolean
        'The following demonstrates how to ensure that the connected instrument is
        'an IntuiLink Agt4395 supported instrument
        Dim vInstrList As Variant           'variant to hold supported instrument list
        Dim szModel As String               'variable to hold instrument model string
        Dim i As Integer                    'counter variable
                
        'Get the currently connected model and the supported models list
        SupportedModel = False
        vInstrList = Agt4395.Utilities.SupportedModels
        szModel = Agt4395.Utilities.InstrumentModel
        
        'Search the list and exit True if the model matches a model in the list
        For i = 0 To UBound(vInstrList)
            If UCase$(szModel) = UCase$(vInstrList(i)) Then
                SupportedModel = True
                Exit Function
            End If 'UCase$(szModel) = UCase$(vInstrList(i))
        Next i
End Function


Private Sub mnuAutomationServer_Click()
    'The following demonstrates how to get information about the automation server
    MsgBox Agt4395.Utilities.ComponentManufacturer & vbCrLf & _
           "Component: " & Agt4395.Utilities.ComponentDescription & vbCrLf & _
           "Version: " & Agt4395.Utilities.ComponentVersion & vbCrLf & _
           "Program ID: " & Agt4395.Utilities.ComponentProgID, vbInformation, "About Get Agt4395 Data"
End Sub

Private Sub mnuCapture_Click()
    Call GetScreenImage
End Sub

Private Sub mnuCopyToClipboard_Click()
    Dim szTemp As String                'temporary string variable
    
    szTemp = lblIStatus.Caption
    lblIStatus.Caption = "Copying"
    
    'clear the contents of the clipboard and set it to an image of type Metafile
    Clipboard.Clear
    Clipboard.SetData Image1.Picture, vbCFMetafile
    
    lblIStatus.Caption = szTemp
End Sub

Private Sub mnuDisclaimer_Click()
    MsgBox "Copyright © 2003 Agilent Technologies Inc.  All rights reserved." & _
           vbCrLf & vbCrLf & _
           "You have a royalty-free right to use, modify, reproduce and distribute" & vbCrLf & _
           "the Sample Application Files (and/or any modified version) in any way" & vbCrLf & _
           "you find useful, provided that you agree that Agilent has no" & vbCrLf & _
           "warranty,  obligations or liability for any Sample Application Files." & _
           vbCrLf & vbCrLf & _
           "Agilent provides programming examples for illustration only," & vbCrLf & _
           "This sample program assumes that you are familiar with the programming" & vbCrLf & _
           "language being demonstrated and the tools used to create and debug" & vbCrLf & _
           "procedures. Agilent support engineers can help explain the" & vbCrLf & _
           "functionality of Agilent software components and associated" & vbCrLf & _
           "commands, but they will not modify these samples to provide added" & vbCrLf & _
           "functionality or construct procedures to meet your specific needs.", , "Disclaimer"
End Sub

Private Sub mnuPrint_Click()
    Dim TimerFlag As Boolean                'flag denoting whether timer is enabled
    Dim szTemp As String                    'temporary string variable
    
    szTemp = lblIStatus.Caption
    lblIStatus.Caption = "Printing"
    
    'If the timer is enabled, disable it while sending the print job
    If Timer1.Enabled = True Then
        Timer1.Enabled = False
        TimerFlag = True
    End If
    
    On Error GoTo Skip_Printer
    CommonDialog1.ShowPrinter
    
    'The following will print just the picture
    Printer.PaintPicture Image1.Picture, 0, 0
    Printer.EndDoc
Skip_Printer:

    'The following prints the whole form
    'Me.PrintForm
    
    'Re-enable the timer
    If TimerFlag Then
        Timer1.Enabled = True
    End If

    lblIStatus.Caption = szTemp
End Sub

Private Sub mnuQuit_Click()
    'Close the application, but make sure the instrument is disconnected first
    If (Agt4395.ConnectedStatus) Then
        Call cmdDisconnect_Click
    End If
    
    'Set the object to nothing to clean up and exit
    Set Agt4395 = Nothing
    End

End Sub

Private Sub mnuSave_Display_Click()
On Error GoTo CaptureError
    Dim szTemp As String                'temporary string variable
    
    szTemp = lblIStatus.Caption
        
    'The following example demonstrates how to save a shot of the instrument display
    'to a file using a common dialog to get the filename and set the proper extension
    CommonDialog1.Filter = "GIF (*.gif)|*.gif|Windows Bitmap (*.bmp)|*.bmp|" & _
        "Windows Metafile (*.wmf)|*.wmf|JPEG File Interchange Format (*.jpg)|*.jpg|" & _
        "Tagged Image File Format (*.tif)|*.tif|Windows Enhanced Metafile (*.emf)|*.emf"
    CommonDialog1.Flags = cdlOFNOverwritePrompt
    CommonDialog1.DialogTitle = "Save display image as..."
    CommonDialog1.ShowSave
    
    'Save instrument display image
    If (CommonDialog1.FileName <> "") Then 'user entered a filename
        lblIStatus.Caption = "Saving"
        Agt4395.SaveScreenImage CommonDialog1.FileName, Agt_ImageFormat_UseSuffix
        MsgBox "Instrument Display saved as " & CommonDialog1.FileName, , "Image Saved"
    
    Else 'user did not enter a filename
        MsgBox "Invalid filename, image not saved", vbExclamation, "Image Not Saved"
    End If '(CommonDialog1.FileName <> "")
    
    lblIStatus.Caption = szTemp
    Exit Sub

CaptureError:
    'user hit cancel
    lblIStatus.Caption = szTemp
End Sub

Private Sub mnuSave_Image_Click()
On Error GoTo CaptureError
    Dim szTemp As String                'temporary string variable
    
    szTemp = lblIStatus.Caption
       
    'Use a common dialog to get the filename and set the proper extension
    CommonDialog1.Filter = "Enhanced Metafile (*.emf)|*.emf|"
    CommonDialog1.Flags = cdlOFNOverwritePrompt
    CommonDialog1.ShowSave
    
    'Save the current image
    If (CommonDialog1.FileName <> "") Then 'user entered a filename
        lblIStatus.Caption = "Saving"
        SavePicture Image1.Picture, CommonDialog1.FileName
        MsgBox "Image saved as " & CommonDialog1.FileName, , "File Saved"
    
    Else 'user did not enter a filename
        MsgBox "Invalid filename, image not saved", vbExclamation, "Image Not Saved"
    End If '(CommonDialog1.FileName <> "")
    
    lblIStatus.Caption = szTemp
    Exit Sub

CaptureError:
    'user hit cancel
    lblIStatus.Caption = szTemp
End Sub

Private Sub Timer1_Timer()
    DoEvents
    'Capture the instrument display
    Call GetScreenImage
End Sub

Private Sub txtInterval_Change()
    
    If txtInterval = "" Then 'Capture Interval is blank; default it to 1
        txtInterval = "0"
    End If 'txtInterval = ""
    
    'Update the timer interval if the Capture Interval changes
    Timer1.Interval = CLng(txtInterval.Text) * 1000
End Sub





