frmsrq.frm

利用vb6进行srq访问cec488口

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Detecting SRQ with CEC488"
   ClientHeight    =   6870
   ClientLeft      =   1965
   ClientTop       =   1665
   ClientWidth     =   7365
   LinkTopic       =   "Form1"
   ScaleHeight     =   6870
   ScaleWidth      =   7365
   Begin VB.TextBox txtNumPts 
      Height          =   375
      Left            =   3000
      TabIndex        =   7
      Text            =   "20"
      Top             =   2040
      Width           =   495
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   495
      Left            =   720
      TabIndex        =   6
      Top             =   4440
      Width           =   2055
   End
   Begin VB.CommandButton cmdGet 
      Caption         =   "Retrieve Data"
      Enabled         =   0   'False
      Height          =   495
      Left            =   720
      TabIndex        =   5
      Top             =   3600
      Width           =   2055
   End
   Begin VB.TextBox GPIBaddr 
      Height          =   375
      Left            =   2160
      TabIndex        =   3
      Text            =   "16"
      Top             =   840
      Width           =   495
   End
   Begin VB.ListBox List1 
      Height          =   5325
      Left            =   3840
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   960
      Width           =   3015
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "Start"
      Enabled         =   0   'False
      Height          =   495
      Left            =   720
      TabIndex        =   1
      Top             =   2760
      Width           =   2055
   End
   Begin VB.CommandButton cmdSetup 
      Caption         =   "Setup"
      Height          =   495
      Left            =   720
      TabIndex        =   0
      Top             =   1440
      Width           =   2055
   End
   Begin VB.Label lblStatus 
      BackColor       =   &H8000000E&
      Height          =   375
      Left            =   600
      TabIndex        =   9
      Top             =   5280
      Width           =   2775
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Number of Samples: "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   600
      TabIndex        =   8
      Top             =   2160
      Width           =   2175
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "GPIB Addr: "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   840
      TabIndex        =   4
      Top             =   840
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' this example was tested using KPCI-488 and version 6.02 of the CEC488 driver
' in Win98SE.  this program was written in VB6.
'
' both the models 2000 and 2700 were used.
'
'the ieeeve.bas module is specific to GPIB cards from CEC:
' KPCI-488, KPC-488.2 or KPC-488.2AT
'
Dim status As Integer
Dim cmd As String
Dim read As String
Dim l As Integer  ' length of read

Private Sub cmdExit_Click()
' put instr back to local
Call transmit("GTL", status%)
Unload Me
End
End Sub

Private Sub cmdGet_Click()
Dim counter As Integer
Dim buffLength As String
Dim ParsedData() As String

cmd$ = "stat:meas?"  ' how many characters of data do we have in buffer?
Call send(GPIBaddr.Text, cmd$, status%)
Call enter(buffLength$, 80, l%, GPIBaddr.Text, status%)

cmd$ = "trac:data?"
Call send(GPIBaddr.Text, cmd$, status%) ' tell it to send us the buffer
' use enter to get the buffer
Call enter(read$, CInt(buffLength) + 10, CInt(buffLength), GPIBaddr.Text, status%)
' TODO:  make use of the split function...

ParsedData = Split(read$, ",")  ' data are a comma delimited string

For counter = 0 To CInt(txtNumPts.Text) - 1
List1.AddItem "Reading # " & Str(counter) & ":  " & ParsedData(counter)
Next counter

cmdGet.Enabled = False
cmdSetup.Enabled = True

End Sub

Private Sub cmdSetup_Click()
    Call send(GPIBaddr.Text, ":ABORT;*RST", status%)
    cmd$ = "stat:pres"
    Call send(GPIBaddr.Text, cmd$, status%)
    cmd$ = "stat:meas:enab 512"       ' 2 raised to 9th power....buffer is full
    Call send(GPIBaddr.Text, cmd$, status%)  ' of measurement enable register
    cmd$ = "*sre 1"        ' service request enable on MSB (bit 0)
    Call send(GPIBaddr.Text, cmd$, status%)
    cmd$ = "trig:coun " & txtNumPts.Text   ' how many points
    Call send(GPIBaddr.Text, cmd$, status%)
    cmd$ = "trac:poin " & txtNumPts.Text   ' how many points
    Call send(GPIBaddr.Text, cmd$, status%)
    cmd$ = "trac:feed sens1;feed:cont next"
    Call send(GPIBaddr.Text, cmd$, status%)
    cmd$ = "form:elem read"
    Call send(GPIBaddr.Text, cmd$, status%)
    cmd$ = "SENSE:FUNC 'VOLT'"
    Call send(GPIBaddr.Text, cmd$, status%)
    
    cmdStart.Enabled = True
    cmdSetup.Enabled = False
    End Sub

Private Sub cmdStart_Click()
cmdStart.Enabled = False
List1.Clear
    
    Call send(GPIBaddr.Text, "init", status%)  ' start the measurements....
    ' detect the SRQ from code
        Do
        DoEvents
        lblStatus.Caption = "Testing for SRQ...."
        Loop Until srq  ' srq is a function of CEC488 API
        lblStatus.Caption = "SRQ detected...."
        ' bit 0, decimal 1, will be set to 1 when MSB is asserted
        Call spoll(GPIBaddr.Text, srq, status%)
       cmdGet.Enabled = True
Beep
Beep
End Sub

Private Sub Form_Load()
Call initialize(21, 0)
' reset
    Call send(GPIBaddr.Text, "*RST", status%)
    Call send(GPIBaddr.Text, ";*cls", status%)

End Sub