home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / SICL / data1.cab / sicl32 / vb / samples / scope / scope.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-03-02  |  14.1 KB  |  405 lines
  1. VERSION 4.00
  2. Begin VB.Form scope 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H00FFFFFF&
  6.    Caption         =   "Hewlett-Packard"
  7.    ClientHeight    =   4185
  8.    ClientLeft      =   585
  9.    ClientTop       =   1875
  10.    ClientWidth     =   7350
  11.    BeginProperty Font 
  12.       name            =   "MS Sans Serif"
  13.       charset         =   1
  14.       weight          =   700
  15.       size            =   8.25
  16.       underline       =   0   'False
  17.       italic          =   0   'False
  18.       strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    Height          =   4545
  22.    Left            =   525
  23.    LinkMode        =   1  'Source
  24.    LinkTopic       =   "Form1"
  25.    ScaleHeight     =   4185
  26.    ScaleWidth      =   7350
  27.    Top             =   1575
  28.    Width           =   7470
  29.    Begin VB.TextBox txtSdiv 
  30.       Appearance      =   0  'Flat
  31.       BeginProperty Font 
  32.          name            =   "MS Sans Serif"
  33.          charset         =   1
  34.          weight          =   700
  35.          size            =   12
  36.          underline       =   0   'False
  37.          italic          =   0   'False
  38.          strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   495
  41.       Left            =   5160
  42.       TabIndex        =   3
  43.       Top             =   3600
  44.       Width           =   975
  45.    End
  46.    Begin VB.TextBox txtOffset 
  47.       Appearance      =   0  'Flat
  48.       BeginProperty Font 
  49.          name            =   "MS Sans Serif"
  50.          charset         =   1
  51.          weight          =   700
  52.          size            =   12
  53.          underline       =   0   'False
  54.          italic          =   0   'False
  55.          strikethrough   =   0   'False
  56.       EndProperty
  57.       Height          =   495
  58.       Left            =   5160
  59.       TabIndex        =   2
  60.       Top             =   3120
  61.       Width           =   975
  62.    End
  63.    Begin VB.TextBox txtVdiv 
  64.       Appearance      =   0  'Flat
  65.       BackColor       =   &H00FFFFFF&
  66.       BeginProperty Font 
  67.          name            =   "MS Sans Serif"
  68.          charset         =   1
  69.          weight          =   700
  70.          size            =   12
  71.          underline       =   0   'False
  72.          italic          =   0   'False
  73.          strikethrough   =   0   'False
  74.       EndProperty
  75.       Height          =   495
  76.       Left            =   5160
  77.       TabIndex        =   1
  78.       Top             =   2640
  79.       Width           =   975
  80.    End
  81.    Begin VB.TextBox txtStatus 
  82.       Appearance      =   0  'Flat
  83.       Height          =   375
  84.       Left            =   5160
  85.       TabIndex        =   12
  86.       Top             =   2040
  87.       Width           =   1935
  88.    End
  89.    Begin VB.CommandButton cmdExit 
  90.       Appearance      =   0  'Flat
  91.       BackColor       =   &H80000005&
  92.       Caption         =   "Exit"
  93.       Height          =   375
  94.       Left            =   5160
  95.       TabIndex        =   8
  96.       Top             =   1560
  97.       Width           =   1575
  98.    End
  99.    Begin VB.CommandButton cmdPrint 
  100.       Appearance      =   0  'Flat
  101.       BackColor       =   &H80000005&
  102.       Caption         =   "Print Form"
  103.       Height          =   375
  104.       Left            =   5160
  105.       TabIndex        =   11
  106.       Top             =   1080
  107.       Width           =   1575
  108.    End
  109.    Begin VB.CommandButton cmdIntegral 
  110.       Appearance      =   0  'Flat
  111.       BackColor       =   &H80000005&
  112.       Caption         =   "Integral"
  113.       Height          =   375
  114.       Left            =   5160
  115.       TabIndex        =   10
  116.       Top             =   600
  117.       Width           =   1575
  118.    End
  119.    Begin VB.CommandButton cmdGetWaveform 
  120.       Appearance      =   0  'Flat
  121.       BackColor       =   &H80000005&
  122.       Caption         =   "Waveform"
  123.       Height          =   375
  124.       Left            =   5160
  125.       TabIndex        =   0
  126.       Top             =   120
  127.       Width           =   1575
  128.    End
  129.    Begin VB.PictureBox Picture1 
  130.       Appearance      =   0  'Flat
  131.       BackColor       =   &H0080FFFF&
  132.       BorderStyle     =   0  'None
  133.       ForeColor       =   &H80000008&
  134.       Height          =   495
  135.       Left            =   120
  136.       ScaleHeight     =   495
  137.       ScaleWidth      =   495
  138.       TabIndex        =   9
  139.       Top             =   120
  140.       Width           =   495
  141.    End
  142.    Begin VB.Label Label3 
  143.       Appearance      =   0  'Flat
  144.       BackColor       =   &H00FFFF00&
  145.       Caption         =   "S/Div"
  146.       BeginProperty Font 
  147.          name            =   "MS Sans Serif"
  148.          charset         =   1
  149.          weight          =   700
  150.          size            =   12
  151.          underline       =   0   'False
  152.          italic          =   0   'False
  153.          strikethrough   =   0   'False
  154.       EndProperty
  155.       ForeColor       =   &H00FF0000&
  156.       Height          =   375
  157.       Left            =   6240
  158.       TabIndex        =   6
  159.       Top             =   3600
  160.       Width           =   855
  161.    End
  162.    Begin VB.Label Label2 
  163.       Appearance      =   0  'Flat
  164.       BackColor       =   &H00FFFF00&
  165.       Caption         =   "Offset"
  166.       BeginProperty Font 
  167.          name            =   "MS Sans Serif"
  168.          charset         =   1
  169.          weight          =   700
  170.          size            =   12
  171.          underline       =   0   'False
  172.          italic          =   0   'False
  173.          strikethrough   =   0   'False
  174.       EndProperty
  175.       ForeColor       =   &H00FF0000&
  176.       Height          =   375
  177.       Left            =   6240
  178.       TabIndex        =   5
  179.       Top             =   3120
  180.       Width           =   855
  181.    End
  182.    Begin VB.Label Label1 
  183.       Appearance      =   0  'Flat
  184.       BackColor       =   &H00FFFF00&
  185.       Caption         =   "V/Div"
  186.       BeginProperty Font 
  187.          name            =   "MS Sans Serif"
  188.          charset         =   1
  189.          weight          =   700
  190.          size            =   12
  191.          underline       =   0   'False
  192.          italic          =   0   'False
  193.          strikethrough   =   0   'False
  194.       EndProperty
  195.       ForeColor       =   &H00FF0000&
  196.       Height          =   375
  197.       Left            =   6240
  198.       TabIndex        =   4
  199.       Top             =   2640
  200.       Width           =   855
  201.    End
  202.    Begin VB.Label Label4 
  203.       Appearance      =   0  'Flat
  204.       BackColor       =   &H00FFFF00&
  205.       Caption         =   "Agilent 54601A OSCILLOSCOPE"
  206.       BeginProperty Font 
  207.          name            =   "MS Sans Serif"
  208.          charset         =   1
  209.          weight          =   700
  210.          size            =   12
  211.          underline       =   0   'False
  212.          italic          =   0   'False
  213.          strikethrough   =   0   'False
  214.       EndProperty
  215.       ForeColor       =   &H00FF0000&
  216.       Height          =   375
  217.       Left            =   720
  218.       TabIndex        =   7
  219.       Top             =   240
  220.       Width           =   4095
  221.    End
  222. Attribute VB_Name = "scope"
  223. Attribute VB_Creatable = False
  224. Attribute VB_Exposed = False
  225. Dim waveform(4000) As Integer       ' Waveform array
  226. Dim preamble(50) As Double          ' Preamble array
  227. Const scope_address = "hpib7,1"     ' Address of SCOPE
  228. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  229. ' This routine terminates the application.  Note that we
  230. ' need to use Unload Me so that the form unload procedure
  231. ' is called and siclcleanup occurs.
  232. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  233. Private Sub cmdExit_Click()
  234.    Unload Me
  235. End Sub
  236. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  237. '  This routine uses the Standard Instrument control
  238. '  Library to get and plot waveform data from an
  239. '  Agilent 54601A (or compatible) scope.
  240. '  Note that any SICL errors that occur are displayed in
  241. '  the txtStatus Text box.
  242. '  This routine is called each time the cmdGetWaveform
  243. '  Command button is clicked.
  244. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  245. Private Sub cmdGetWaveform_Click()
  246.    Dim scope_id As Integer          ' device session id for scope
  247.    Dim intf_id As Integer           ' interface session id
  248.    Dim xaxis As Integer             ' used to draw the waveform
  249.    Dim numargs As Integer           ' # of args processed ivprintf/ivscanf
  250. '  Set up Error Handler within this subroutine that will get
  251. '  called if a SICL error occurs.
  252.    On Error GoTo errorhandler:
  253. '  Disable the button used to initiate I/O while I/O is being
  254. '  performed.
  255.    cmdGetWaveform.Enabled = False
  256. '  Make sure text boxes are clear
  257.    txtVdiv.Text = ""
  258.    txtOffset.Text = ""
  259.    txtSdiv.Text = ""
  260. '  Open a device session using the device address specified by
  261. '  the scope_address string.
  262.    scope_id = iopen(scope_address)
  263.    txtStatus.Text = "iopen - no error"
  264. '  Open an interface session to the interface that the scope
  265. '  is connected to.  Then call iclear to reset the interface.
  266.    intf_id = igetintfsess(scope_id)
  267.    Call iclear(intf_id)
  268.    txtStatus.Text = "iclear - no error"
  269. '  Set the I/O timeout for the scope's device session to 3 seconds
  270.    Call itimeout(scope_id, 3000)
  271.    txtStatus.Text = "itimeout - no error"
  272. '  Set up the scope
  273.    numargs = ivprintf(scope_id, ":AUTOSCALE" + Chr$(10))
  274.    txtStatus.Text = "ivprintf - no error"
  275.    numargs = ivprintf(scope_id, ":WAVEFORM:FORMAT WORD" + Chr$(10))
  276.    txtStatus.Text = "ivprintf - no error"
  277.    numargs = ivprintf(scope_id, ":DIGITIZE:CHANNEL1" + Chr$(10))
  278.    txtStatus.Text = "ivprintf - no error"
  279. '  Read the preamble
  280.    numargs = ivprintf(scope_id, ":WAVEFORM:PREAMBLE?" + Chr$(10))
  281.    txtStatus.Text = "ivprintf - no error"
  282.    numargs = ivscanf(scope_id, "%,50lf", preamble())
  283.    txtStatus.Text = "ivscanf - no error"
  284. '  Read the waveform data
  285.    numargs = ivprintf(scope_id, ":WAVEFORM:DATA?" + Chr$(10))
  286.    txtStatus.Text = "ivprintf - no error"
  287.    numargs = ivscanf(scope_id, "%4000wb" + Chr$(10), waveform())
  288.    txtStatus.Text = "ivscanf - no error"
  289. '  Close device session for scope
  290.    Call iclose(scope_id)
  291.    txtStatus.Text = "iclose - no error"
  292. '  Deal with the preamble
  293.    VpD = (32 * preamble(7))
  294.    Off = (128 - preamble(9)) * preamble(7) + preamble(8)
  295.    SpD = preamble(2) * preamble(4) / 10
  296.    txtVdiv.Text = Str$(VpD)
  297.    txtOffset.Text = Str$(Off)
  298.    txtSdiv.Text = Str$(SpD)
  299.    Cls
  300. '  Set up the screen coordinate system
  301.    ScaleLeft = 0
  302.    ScaleTop = 330
  303.    ScaleWidth = 6000
  304.    ScaleHeight = -330
  305. '  Draw the Grid
  306. '  Main Border
  307.    Line (100, 10)-(4100, 10), RGB(0, 128, 0)
  308.    Line -(4100, 266), RGB(0, 128, 0)
  309.    Line -(100, 266), RGB(0, 128, 0)
  310.    Line -(100, 10), RGB(0, 128, 0)
  311. '  Y-axis grid
  312.    Line (500, 10)-(500, 266), RGB(0, 128, 0)
  313.    Line (900, 10)-(900, 266), RGB(0, 128, 0)
  314.    Line (1300, 10)-(1300, 266), RGB(0, 128, 0)
  315.    Line (1700, 10)-(1700, 266), RGB(0, 128, 0)
  316.    Line (2100, 10)-(2100, 266), RGB(255, 0, 0)
  317.    Line (2500, 10)-(2500, 266), RGB(0, 128, 0)
  318.    Line (2900, 10)-(2900, 266), RGB(0, 128, 0)
  319.    Line (3300, 10)-(3300, 266), RGB(0, 128, 0)
  320.    Line (3700, 10)-(3700, 266), RGB(0, 128, 0)
  321. '  X-axis grid
  322.    Line (100, 42)-(4100, 42), RGB(0, 128, 0)
  323.    Line (100, 74)-(4100, 74), RGB(0, 128, 0)
  324.    Line (100, 106)-(4100, 106), RGB(0, 128, 0)
  325.    Line (100, 138)-(4100, 138), RGB(255, 0, 0)
  326.    Line (100, 170)-(4100, 170), RGB(0, 128, 0)
  327.    Line (100, 202)-(4100, 202), RGB(0, 128, 0)
  328.    Line (100, 234)-(4100, 234), RGB(0, 128, 0)
  329. '  Draw the waveform
  330.    CurrentX = 100
  331.    CurrentY = waveform(0) + 10
  332.    For xaxis = 1 To 3999
  333.        Line -(xaxis + 100, waveform(xaxis) + 10)
  334.    Next xaxis
  335. '  Clear the status text box
  336.    txtStatus.Text = ""
  337. '  Enable the button used to initiate I/O
  338.    cmdGetWaveform.Enabled = True
  339.    Exit Sub
  340. errorhandler:
  341. '  Display the error message in the txtStatus TextBox.
  342.    txtStatus.Text = Error$
  343. '  Close the scope_id and intf_id sessions if iopen was successful
  344.    If scope_id <> 0 Then
  345.       iclose (scope_id)
  346.    End If
  347. '  Enable the button used to initiate I/O
  348.    cmdGetWaveform.Enabled = True
  349.    Exit Sub
  350. End Sub
  351. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  352. '  This routine calculates and plots the integral for the
  353. '  waveform obtained by the cmdGetWaveform_Click routine.
  354. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  355. Private Sub cmdIntegral_Click()
  356.    Dim i As Integer         ' loop counter
  357.    Dim max As Single        ' max of integral
  358.    Dim min As Single        ' min of integral
  359.    Dim addval As Single     ' used to draw integral
  360.    Dim scaleval As Single   ' used to draw integral
  361. '  first, make sure that there is a waveform in memory...
  362.    If preamble(2) = 0 Then
  363.       MsgBox ("Must retrieve waveform first...")
  364.       Exit Sub
  365.    End If
  366. '  Disable the button used to initiate the integral operation
  367. '  while it is being performed.
  368.    cmdIntegral.Enabled = False
  369.    ReDim Math(preamble(2)) As Single
  370. '  calculate the integral
  371.    Math(0) = 0
  372.    For i = 1 To preamble(2) - 1
  373.       Math(i) = Math(i - 1) + (waveform(i) - preamble(9)) * preamble(7) + preamble(8)
  374.    Next i
  375. '  calculate the min and max of the integral
  376.    max = Math(0)
  377.    min = Math(0)
  378.    For i = 1 To preamble(2) - 1
  379.       If Math(i) > max Then max = Math(i)
  380.       If Math(i) < min Then min = Math(i)
  381.    Next i
  382. '  plot the integral
  383.    scaleval = 256 / (max - min)
  384.    addval = (-min * scaleval) + 10
  385.    For i = 0 To preamble(2) - 1
  386.       PSet (i + 100, Math(i) * scaleval + addval), RGB(0, 0, 255)
  387.    Next i
  388. '  enable the button used to initiate the integral operation
  389.    cmdIntegral.Enabled = True
  390. End Sub
  391. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  392. ' This routine prints the main form.
  393. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  394. Private Sub cmdPrint_Click()
  395.    scope.PrintForm
  396. End Sub
  397. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  398. '  The following routine is called when the application's
  399. '  Start Up form is unloaded.  It calls siclcleanup to
  400. '  release resources allocated by SICL for this
  401. '  application.
  402. Private Sub Form_Unload(Cancel As Integer)
  403.    Call siclcleanup     ' Tell SICL to clean up for this task
  404. End Sub
  405.