本機器の設定
8.5 WORD(2バイト)形式での波形データの出力
Sample2(GPIB) Get Word Data
---Private Function GpibGetWord() As Integer
Dim msg As String 'Command buffer Dim qry As String 'Query biffer Dim sts As Integer
Dim vdv As Variant 'Vdiv value Dim ofs As Variant 'Offset value Dim eos As Integer 'EOS
Dim hlg As Integer 'Block Header Length Dim dlg As Integer 'Block Data Length Dim dat As Variant 'Data
Dim i As Integer msg = Space$(100) qry = Space$(100)
sts = InitGpib 'Initialize GPIB If (sts <> 0) Then
GpibGetWord = 1 Exit Function End If
msg = "STOP" + Term 'Stop Acquisition sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
msg = "COMMUNICATE:HEADER OFF" + Term 'Query Header Off(for Get V/div) sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
msg = "WAVEFORM:TRACE 1" + Term 'Trace = 1 sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
msg = "WAVEFORM:RECORD 0" + Term 'Record number = 0 sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
msg = "WAVEFORM:FORMAT WORD" + Term 'Data Format = WORD sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
msg = "WAVEFORM:BYTEORDER LSBFIRST" + Term 'Data Byte order = LSB First(for Little Endian)
sts = ilwrt(Dev, msg, Len(msg)) If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
msg = "WAVEFORM:START 0;END 1001" + Term 'START 0,END 1001(Length = 1002) sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
msg = "WAVEFORM:RANGE?" + Term 'Get V/div value sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
sts = ilrd(Dev, qry, Len(qry)) If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
vdv = Val(qry)
msg = "WAVEFORM:OFFSET?" + Term 'Get Offset value sts = ilwrt(Dev, msg, Len(msg))
サ ン プ ル プ ロ グ ラ ム
8-9
IM 701610-17
2
3
4
5
6
7
8
付
索
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
sts = ilrd(Dev, qry, Len(qry)) If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
ofs = Val(qry) eos = 0
sts = ileos(Dev, eos) 'Terminator = None(for Binary Data) If (sts < 0) Then
Call DisplayGPIBError(sts, "ileos") GpibGetWord = 1
Exit Function End If
msg = "WAVEFORM:SEND?" + Term 'Receive Waveform Data sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
sts = ilrd(Dev, qry, 2) 'Receive "#X"
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
hlg = Val(Mid$(qry, 2, 1))
sts = ilrd(Dev, qry, hlg) 'Receive Block Header If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
dlg = Val(Left$(qry, hlg)) 'dlg = Data Byte Length sts = ilrdi(Dev, WaveBuffer(), dlg + 1) 'Receive Waveform Data + LF If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
For i = 0 To (dlg / 2 - 1) Step 1
dat = WaveBuffer(i) * vdv / 3072 + ofs List1.AddItem CStr(i) + ":" + CStr(dat) Next i
eos = &HC0A
sts = ileos(Dev, eos) 'Terminator = LF If (sts < 0) Then
Call DisplayGPIBError(sts, "ileos") GpibGetWord = 1
Exit Function End If
msg = "COMMUNICATE:HEADER ON" + Term 'Query Header On sts = ilwrt(Dev, msg, Len(msg))
If (sts < 0) Then
Call DisplayGPIBError(sts, msg) GpibGetWord = 1
Exit Function End If
Call ibonl(Dev, 0) GpibGetWord = 0 End Function
---Sample5(RS232) Get Word Data
---Private Function RS232GetWord() As Integer
Dim msg As String 'Command buffer Dim qry As String 'Query biffer Dim sts As Integer
Dim vdv As Variant 'V/div value Dim ofs As Variant 'Offset value Dim hlg As Integer 'Block Header Length Dim dlg As Integer 'Blocl Data Length Dim buf As Variant 'temporary buffer Dim dat As Variant 'data buffer Dim i As Integer
msg = Space$(100) qry = CStr(Empty)
sts = InitSerial 'Initialize RS232
Exit Function End If
MSComm1.InputLen = 0 'Receive All Data MSComm1.InputMode = comInputModeText 'Text Mode MSComm1.PortOpen = True 'Port Open MSComm1.OutBufferCount = 0 'Out Buffer Clear MSComm1.InBufferCount = 0 'In Buffer Clear Timer1.Interval = 1000
If CtsFlag = 1 Then 'If CTS = FALSE TimerCount = 1 'Wait unitl CTS = TRUE Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("CTS Timeout") RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.CTSHolding = True End If
msg = "STOP" + Term 'Stop Acquisition MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0
msg = "COMMUNICATE:HEADER OFF" + Term 'Query Header Off(for Get V/div) MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0
msg = "WAVEFORM:TRACE 1" + Term 'Trace = 1 MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0
msg = "WAVEFORM:RECORD 0" + Term 'Record number = 0 MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0
msg = "WAVEFORM:FORMAT WORD" + Term 'Data Format = WORD MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0
msg = "WAVEFORM:BYTEORDER LSBFIRST" + Term 'Data Byte order = LSB First(for Little Endian)
MSComm1.Output = msg TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg)
サ ン プ ル プ ロ グ ラ ム
8-11
IM 701610-17
2
3
4
5
6
7
8
付
索
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0
msg = "WAVEFORM:START 0;END 1001" + Term 'START 0,END 1001(Length = 1002) MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0 qry = CStr(Empty)
msg = "WAVEFORM:RANGE?" + Term 'Get V/div value MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0 TimerCount = 1
Do
qry = qry + MSComm1.Input Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Receive Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until Right$(qry, 1) = Term vdv = Val(qry)
qry = CStr(Empty)
msg = "WAVEFORM:OFFSET?" + Term 'Get Offset value MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0 TimerCount = 1
Do
qry = qry + MSComm1.Input Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Receive Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until Right$(qry, 1) = Term ofs = Val(qry)
msg = "WAVEFORM:SEND?" + Term 'Receive Waveform Data MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0
MSComm1.InputLen = 2 'Receive "#X"
TimerCount = 1
Do Until MSComm1.InBufferCount >= 1 Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Receive Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop
qry = MSComm1.Input hlg = Val(Mid$(qry, 2, 1))
TimerCount = 1
Do Until MSComm1.InBufferCount >= hlg Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Receive Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop
qry = MSComm1.Input
dlg = Val(Left$(qry, hlg)) 'leng% = Data Byte Length MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 2 'Receive Waveform Data(2 Byte) For i = 0 To (dlg / 2 - 1) Step 1 'Loop(dlg)
TimerCount = 1
Do Until MSComm1.InBufferCount >= 2 Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Receive Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop
buf = MSComm1.Input 'Receive 1 Data(2 Byte) dat = buf(1) * 256 + buf(0)
If (dat > 32767) Then dat = dat - 65536 End If
dat = dat * vdv / 3072 + ofs
List1.AddItem CStr(i) + ":" + CStr(dat) Next i
msg = "COMMUNICATE:HEADER ON" + Term 'Query Header On MSComm1.Output = msg
TimerCount = 1 Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg) RS232GetWord = 1
GoTo finish End If
Loop Until MSComm1.OutBufferCount = 0 RS232GetWord = 0
finish:
MSComm1.PortOpen = False 'Port Close Timer1.Interval = 0
End Function
---サ ン プ ル プ ロ グ ラ ム
8-13
IM 701610-17
2
3
4
5
6
7
8
付
索
RS-232