📄 scope.frm
字号:
VERSION 4.00
Begin VB.Form scope
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Caption = "Hewlett-Packard"
ClientHeight = 4185
ClientLeft = 585
ClientTop = 1875
ClientWidth = 7350
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 4545
Left = 525
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 4185
ScaleWidth = 7350
Top = 1575
Width = 7470
Begin VB.TextBox txtSdiv
Appearance = 0 'Flat
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 495
Left = 5160
TabIndex = 3
Top = 3600
Width = 975
End
Begin VB.TextBox txtOffset
Appearance = 0 'Flat
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 495
Left = 5160
TabIndex = 2
Top = 3120
Width = 975
End
Begin VB.TextBox txtVdiv
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 495
Left = 5160
TabIndex = 1
Top = 2640
Width = 975
End
Begin VB.TextBox txtStatus
Appearance = 0 'Flat
Height = 375
Left = 5160
TabIndex = 12
Top = 2040
Width = 1935
End
Begin VB.CommandButton cmdExit
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Exit"
Height = 375
Left = 5160
TabIndex = 8
Top = 1560
Width = 1575
End
Begin VB.CommandButton cmdPrint
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Print Form"
Height = 375
Left = 5160
TabIndex = 11
Top = 1080
Width = 1575
End
Begin VB.CommandButton cmdIntegral
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Integral"
Height = 375
Left = 5160
TabIndex = 10
Top = 600
Width = 1575
End
Begin VB.CommandButton cmdGetWaveform
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Waveform"
Height = 375
Left = 5160
TabIndex = 0
Top = 120
Width = 1575
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H0080FFFF&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 495
Left = 120
ScaleHeight = 495
ScaleWidth = 495
TabIndex = 9
Top = 120
Width = 495
End
Begin VB.Label Label3
Appearance = 0 'Flat
BackColor = &H00FFFF00&
Caption = "S/Div"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 6240
TabIndex = 6
Top = 3600
Width = 855
End
Begin VB.Label Label2
Appearance = 0 'Flat
BackColor = &H00FFFF00&
Caption = "Offset"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 6240
TabIndex = 5
Top = 3120
Width = 855
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H00FFFF00&
Caption = "V/Div"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 6240
TabIndex = 4
Top = 2640
Width = 855
End
Begin VB.Label Label4
Appearance = 0 'Flat
BackColor = &H00FFFF00&
Caption = "HP 54601A OSCILLOSCOPE"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 720
TabIndex = 7
Top = 240
Width = 4095
End
End
Attribute VB_Name = "scope"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim waveform(4000) As Integer ' Waveform array
Dim preamble(50) As Double ' Preamble array
Const scope_address = "hpib7,1" ' Address of SCOPE
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This routine terminates the application. Note that we
' need to use Unload Me so that the form unload procedure
' is called and siclcleanup occurs.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdExit_Click()
Unload Me
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This routine uses the Standard Instrument control
' Library to get and plot waveform data from an
' HP54601A (or compatible) scope.
'
' Note that any SICL errors that occur are displayed in
' the txtStatus Text box.
'
' This routine is called each time the cmdGetWaveform
' Command button is clicked.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdGetWaveform_Click()
Dim scope_id As Integer ' device session id for scope
Dim intf_id As Integer ' interface session id
Dim xaxis As Integer ' used to draw the waveform
Dim numargs As Integer ' # of args processed ivprintf/ivscanf
' Set up Error Handler within this subroutine that will get
' called if a SICL error occurs.
On Error GoTo errorhandler:
' Disable the button used to initiate I/O while I/O is being
' performed.
cmdGetWaveform.Enabled = False
' Make sure text boxes are clear
txtVdiv.Text = ""
txtOffset.Text = ""
txtSdiv.Text = ""
' Open a device session using the device address specified by
' the scope_address string.
scope_id = iopen(scope_address)
txtStatus.Text = "iopen - no error"
' Open an interface session to the interface that the scope
' is connected to. Then call iclear to reset the interface.
intf_id = igetintfsess(scope_id)
Call iclear(intf_id)
txtStatus.Text = "iclear - no error"
' Set the I/O timeout for the scope's device session to 3 seconds
Call itimeout(scope_id, 3000)
txtStatus.Text = "itimeout - no error"
' Set up the scope
numargs = ivprintf(scope_id, ":AUTOSCALE" + Chr$(10))
txtStatus.Text = "ivprintf - no error"
numargs = ivprintf(scope_id, ":WAVEFORM:FORMAT WORD" + Chr$(10))
txtStatus.Text = "ivprintf - no error"
numargs = ivprintf(scope_id, ":DIGITIZE:CHANNEL1" + Chr$(10))
txtStatus.Text = "ivprintf - no error"
' Read the preamble
numargs = ivprintf(scope_id, ":WAVEFORM:PREAMBLE?" + Chr$(10))
txtStatus.Text = "ivprintf - no error"
numargs = ivscanf(scope_id, "%,50lf", preamble())
txtStatus.Text = "ivscanf - no error"
' Read the waveform data
numargs = ivprintf(scope_id, ":WAVEFORM:DATA?" + Chr$(10))
txtStatus.Text = "ivprintf - no error"
numargs = ivscanf(scope_id, "%4000wb" + Chr$(10), waveform())
txtStatus.Text = "ivscanf - no error"
' Close device session for scope
Call iclose(scope_id)
txtStatus.Text = "iclose - no error"
' Deal with the preamble
VpD = (32 * preamble(7))
Off = (128 - preamble(9)) * preamble(7) + preamble(8)
SpD = preamble(2) * preamble(4) / 10
txtVdiv.Text = Str$(VpD)
txtOffset.Text = Str$(Off)
txtSdiv.Text = Str$(SpD)
Cls
' Set up the screen coordinate system
ScaleLeft = 0
ScaleTop = 330
ScaleWidth = 6000
ScaleHeight = -330
' Draw the Grid
' Main Border
Line (100, 10)-(4100, 10), RGB(0, 128, 0)
Line -(4100, 266), RGB(0, 128, 0)
Line -(100, 266), RGB(0, 128, 0)
Line -(100, 10), RGB(0, 128, 0)
' Y-axis grid
Line (500, 10)-(500, 266), RGB(0, 128, 0)
Line (900, 10)-(900, 266), RGB(0, 128, 0)
Line (1300, 10)-(1300, 266), RGB(0, 128, 0)
Line (1700, 10)-(1700, 266), RGB(0, 128, 0)
Line (2100, 10)-(2100, 266), RGB(255, 0, 0)
Line (2500, 10)-(2500, 266), RGB(0, 128, 0)
Line (2900, 10)-(2900, 266), RGB(0, 128, 0)
Line (3300, 10)-(3300, 266), RGB(0, 128, 0)
Line (3700, 10)-(3700, 266), RGB(0, 128, 0)
' X-axis grid
Line (100, 42)-(4100, 42), RGB(0, 128, 0)
Line (100, 74)-(4100, 74), RGB(0, 128, 0)
Line (100, 106)-(4100, 106), RGB(0, 128, 0)
Line (100, 138)-(4100, 138), RGB(255, 0, 0)
Line (100, 170)-(4100, 170), RGB(0, 128, 0)
Line (100, 202)-(4100, 202), RGB(0, 128, 0)
Line (100, 234)-(4100, 234), RGB(0, 128, 0)
' Draw the waveform
CurrentX = 100
CurrentY = waveform(0) + 10
For xaxis = 1 To 3999
Line -(xaxis + 100, waveform(xaxis) + 10)
Next xaxis
' Clear the status text box
txtStatus.Text = ""
' Enable the button used to initiate I/O
cmdGetWaveform.Enabled = True
Exit Sub
errorhandler:
' Display the error message in the txtStatus TextBox.
txtStatus.Text = Error$
' Close the scope_id and intf_id sessions if iopen was successful
If scope_id <> 0 Then
iclose (scope_id)
End If
' Enable the button used to initiate I/O
cmdGetWaveform.Enabled = True
Exit Sub
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This routine calculates and plots the integral for the
' waveform obtained by the cmdGetWaveform_Click routine.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdIntegral_Click()
Dim i As Integer ' loop counter
Dim max As Single ' max of integral
Dim min As Single ' min of integral
Dim addval As Single ' used to draw integral
Dim scaleval As Single ' used to draw integral
' first, make sure that there is a waveform in memory...
If preamble(2) = 0 Then
MsgBox ("Must retrieve waveform first...")
Exit Sub
End If
' Disable the button used to initiate the integral operation
' while it is being performed.
cmdIntegral.Enabled = False
ReDim Math(preamble(2)) As Single
' calculate the integral
Math(0) = 0
For i = 1 To preamble(2) - 1
Math(i) = Math(i - 1) + (waveform(i) - preamble(9)) * preamble(7) + preamble(8)
Next i
' calculate the min and max of the integral
max = Math(0)
min = Math(0)
For i = 1 To preamble(2) - 1
If Math(i) > max Then max = Math(i)
If Math(i) < min Then min = Math(i)
Next i
' plot the integral
scaleval = 256 / (max - min)
addval = (-min * scaleval) + 10
For i = 0 To preamble(2) - 1
PSet (i + 100, Math(i) * scaleval + addval), RGB(0, 0, 255)
Next i
' enable the button used to initiate the integral operation
cmdIntegral.Enabled = True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This routine prints the main form.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdPrint_Click()
scope.PrintForm
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The following routine is called when the application's
' Start Up form is unloaded. It calls siclcleanup to
' release resources allocated by SICL for this
' application.
'
Private Sub Form_Unload(Cancel As Integer)
Call siclcleanup ' Tell SICL to clean up for this task
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -