Dim AdrComp As Integer ' Computer address
Dim Adr5370 As Integer ' CS-5370P address
Dim Cmd(31) As Long, CmdR(31) As Long, Pstb(31) As Long
Dim Ch1Volt As String
Dim SetSweep As String
Dim CursMode As String
Dim CursMeas As String
Dim L As Long, Voltage As String * 100
Dim BaseColor As Long
Dim talker As Long, stbyte As Long
Dim TimerCount As Single, FLG As Integer, nCycle As Integer
Dim ScaleH As Single, ScaleW As Single, FileName As String, Ans As Integer
Dim Xmin As Single, Xmax As Single, Ymin As Single, Ymax As Single
Dim t(50000) As Single, V(50000) As Single
Dim Vunit As String * 2
　Private Sub Form_Load()
　Form2.Show
　AdrComp = 0 ' computer address
　Adr5370 = 3 ' CS-5370P address
'----------------------------------------------------------------------
　e1 = GpIni() ' GPIB 初期化
　e2 = GpIfc(1) ' インターフェイスクリア (1×100μsec)
　e3 = GpDelim(3, 1) ' デリミタ (LF, EOI on)
　e4 = GpRen() ' GPIB remote enable
　e5 = GpTimeout(2000) ' Timeout (2000×1msec)
　e6 = GpSdc(Adr5370): ' SDC (Select Device Clear)
　If e1 = 0 Then Form2.Text1.Text = "GP-IB Initialization OK" Else Form2.Text1.Text = "GP-IB Initialization Failed"
　If e2 = 0 Then Form2.Text2.Text = "Interface Clear OK" Else Form2.Text2.Text = "Interface Clear Failed"
　If e3 = 0 Then Form2.Text3.Text = "Delimiter OK" Else Form2.Text3.Text = "Delimiter Failed"
　If e4 = 0 Then Form2.Text4.Text = "GP-IB Remote Enable OK" Else Form2.Text4.Text = "GP-IB Remote Enable Failed"
　If e5 = 0 Then Form2.Text5.Text = "Timeout OK" Else Form2.Text5.Text = "Timeout Failed"
　If e6 = 0 Then Form2.Text6.Text = "Select Device Clear OK" Else Form2.Text6.Text = "Select Device Clear Failed"
'-----------------------------------------------------------------------------------------
' e7 = GpCrst(Adr5370): 'Reset (*RST)
' e8 = GpCcls(Adr5370): 'Clear Status (*CLS)
　Cmd(0) = 1 ' トーカ数
　Cmd(1) = Adr5370 ' トーカアドレス
　e7 = GpPoll(Cmd(0), Pstb(0)) ' ポーリング
　talker = Cmd(Pstb(0)) '
　stbyte = Pstb(Pstb(0)) ' RQSビットONのトーカを発見した配列番号
　If e7 = 0 Then Form2.Text7.Text = "Polling OK" Else Form2.Text7.Text = "Polling Failed => " & e7
'------------------------------------------------------------------------------------------
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr5370 ' listener address (CS-5370P)
' Ch1Volt = ":CH1:VOLT 5": L = Len(Ch1Volt)
' Ch1Volt = ":CH1:VOLT 1": L = Len(Ch1Volt)
' Ch1Volt = ":CH1:VOLT 2": L = Len(Ch1Volt)
　Ch1Volt = ":CH1:VOLT 0.5": L = Len(Ch1Volt)
　e = GpTalk(Cmd(0), L, Ch1Volt) ' 送信
' SetSweep = ":SWEEP:A 50E-6": L = Len(SetSweep)
　SetSweep = ":SWEEP:A 500E-6": L = Len(SetSweep)
　e = GpTalk(Cmd(0), L, SetSweep) ' 送信
' CursMode = ":CURS:MODE 5": L = Len(CursMode) ' 5: Frequency
' CursMode = ":CURS:MODE 6": L = Len(CursMode) ' 6: T
　CursMode = ":CURS:MODE 7": L = Len(CursMode) ' 7: Voltage
　e = GpTalk(Cmd(0), L, CursMode) ' 送信
'-----------------------------------------------------------------
　CursMeas = ":CURS:MEAS?": L = Len(CursMeas)
　e = GpTalk(Cmd(0), L, CursMeas) ' 送信
　CmdR(0) = 2 ' talker + listener
　CmdR(1) = Adr5370 ' talker address (CS-5370P)
　CmdR(2) = AdrComp ' listener address (GPIB)
　e = GpListen(CmdR(0), 33, Voltage)
　Text2.Text = 0
　Text3.Text = Val(Mid$(Voltage, 22, 8))
　Vunit = Mid$(Voltage, 30, 2)
　Text2.Text = Vunit
　t(0) = 0
　V(0) = Val(Mid$(Voltage, 22, 8))
'-----------------------------------------------------------------
　e = GpResetren()
　Timer1.Interval = 100 ' (100 msec)
　Timer1.Enabled = False
　ScaleH = 100: ScaleW = 2000
　BaseColor = Command1.BackColor
　Command2.Enabled = False
End Sub

Private Sub Command1_Click()
　Command1.Enabled = False
　Command2.Enabled = True
　Command1.BackColor = vbGreen
　Command2.BackColor = BaseColor
　Xmin = Val(Text6.Text): Xmax = Val(Text7.Text)
　Ymin = Val(Text4.Text): Ymax = Val(Text5.Text)
　e = GpRen() ' GPIB remote enable
　FLG = 0
　If Val(Text1.Text) <= 0 Then
　　Beep
　　e = MsgBox("Sampling time < 0", vbOKOnly, "警告")
　　Exit Sub
　End If
　If Xmax <= Xmin Then
　　Beep
　　e = MsgBox("Xmin > Xmax", vbOKOnly, "警告")
　　Exit Sub
　End If
　If Ymax <= Ymin Then
　　Beep
　　e = MsgBox("Ymin > Ymax", vbOKOnly, "警告")
　　Exit Sub
　End If
　Picture1.Cls
'--------------------------------------------------
　nCycle = 1
　Open "A:\User\Abe\project_VB\CS5370P\dummy.dat" For Output As #2
　　Do
　　　t(nCycle) = t(nCycle - 1) + Val(Text1.Text)
　　　Call Meas

　　　If t(nCycle) > Xmax * 0.95 Then
　　　　Xmax = Xmax * 5#
　　　　Text7.Text = Xmax
　　　　Picture1.Cls
　　　　For i = 1 To nCycle
　　　　　X1 = (t(i - 1) - Xmin) / (Xmax - Xmin) * ScaleW
　　　　　X2 = (t(i) - Xmin) / (Xmax - Xmin) * ScaleW
　　　　　Y1 = ScaleH - (V(i - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Y2 = ScaleH - (V(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Picture1.Line (X1, Y1)-(X2, Y2), 6
　　　　Next i
　　　End If
　　　If V(nCycle) > Ymax Then
　　　　Ymax = V(nCycle)
　　　　Text5.Text = Ymax
　　　　Picture1.Cls
　　　　For i = 1 To nCycle
　　　　　X1 = (t(i - 1) - Xmin) / (Xmax - Xmin) * ScaleW
　　　　　X2 = (t(i) - Xmin) / (Xmax - Xmin) * ScaleW
　　　　　Y1 = ScaleH - (V(i - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Y2 = ScaleH - (V(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Picture1.Line (X1, Y1)-(X2, Y2), 6
　　　　Next i
　　　End If
　　　If V(nCycle) < Ymin Then
　　　　Ymin = V(nCycle)
　　　　Text4.Text = Ymin
　　　　Picture1.Cls
　　　　For i = 1 To nCycle
　　　　　X1 = (t(i - 1) - Xmin) / (Xmax - Xmin) * ScaleW
　　　　　X2 = (t(i) - Xmin) / (Xmax - Xmin) * ScaleW
　　　　　Y1 = ScaleH - (V(i - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Y2 = ScaleH - (V(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Picture1.Line (X1, Y1)-(X2, Y2), 6
　　　　Next i
　　　End If
　　　nCycle = nCycle + 1
　　　If FLG = 1 Then Exit Do
　　Loop
　Close #2
　e = GpResetren()
　Command1.Enabled = True
End Sub

Private Sub Command2_Click()
　FLG = 1
　Command2.BackColor = vbRed
　Command1.BackColor = BaseColor
　Beep
　e = MsgBox("データを保存しますか？", vbYesNo, "確認")
　If e = 6 Then
　　On Error Resume Next
　　CommonDialog1.CancelError = True
　　CommonDialog1.Filter = "データファイル(*.dat)|*.dat|" & "すべてのファイル(*.*)|*.*|"
　　CommonDialog1.FilterIndex = 1
　　CommonDialog1.DefaultExt = "dat"
　　CommonDialog1.ShowSave
　　FileName = CommonDialog1.FileName
　　If Err.Number = cdlCancel Then
　　Exit Sub
　Else
　　If Dir(FileName) <> "" Then Ans = MsgBox("上書きしますか？", vbYesNo, "確認")
　　　If Ans = vbNo Then Exit Sub
　　End If
　　Open FileName For Output As #1
　　　For k = 1 To nCycle
　　　　Print #1, t(k), V(k)
　　　Next k
　　　Beep
　　　MsgBox (FileName & " 保存しました")
　　Close #1
　End If
　Command2.Enabled = False
　Call Meas
End Sub

Private Sub Meas()
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr5370 ' listener address (CS-5370P)
　CursMeas = ":CURS:MEAS?": L = Len(CursMeas)
　ret = GpTalk(Cmd(0), L, CursMeas) ' 送信
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = Adr5370 ' talker address (CS-5370P)
　　CmdR(2) = AdrComp ' listener address (GPIB)
　　e = GpListen(CmdR(0), 33, Voltage)
　　Text2.Text = t(nCycle)
　　Text3.Text = Val(Mid$(Voltage, 22, 8))
　　V(nCycle) = Val(Mid$(Voltage, 22, 8))
　　Print #2, t(nCycle), V(nCycle)
　　X1 = (t(nCycle - 1) - Xmin) / (Xmax - Xmin) * ScaleW
　　X2 = (t(nCycle) - Xmin) / (Xmax - Xmin) * ScaleW
　　Y1 = ScaleH - (V(nCycle - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　Y2 = ScaleH - (V(nCycle) - Ymin) / (Ymax - Ymin) * ScaleH
　　Picture1.Line (X1, Y1)-(X2, Y2), 6
　ElseIf ret >= 252 Then
　　Text5.Text = "Error"
　　e = GpResetren()
　　e = GpExit()
　　End
　End If
　Call delay(Val(Text1.Text)) ' Sampling time
End Sub

Private Sub delay(TimeData)
　TimerCount = 0
　Timer1.Enabled = True
　Do While TimeData >= TimerCount
　　DoEvents
　Loop
　Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
　TimerCount = TimerCount + 0.1 ' (0.1 sec)
End Sub

Private Sub form_unload(cancel As Integer)
　Unload Form2
　e = GpResetren()
　e = GpExit()
End Sub