Dim Eoi As Long, e As Long, BaseColor As Long, errFLG As Integer
Dim ret As Long, 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 Cmd(31) As Long
Dim CmdR(31) As Long
Dim Pstb(31) As Long ' 返送されたステータスバイト配列
Dim temp As String * 100, t(50000) As Single, Tem(50000) As Single
Dim AdrComp As Integer, Adr6485 As Integer

Private Sub Form_Load()
　AdrComp = 0 ' Computer Address
　Adr6485 = 14 ' Keithley 6485 Address
　errFLG = 0
'---------------------------------------------------------------------------------------
　e = GpIni(): If e <> 0 Then errFLG = 1 ' GPIB 初期化
　e = GpIfc(1): If e <> 0 Then errFLG = 1 ' インターフェイスクリア (1×100μsec)
　e = GpRen(): If e <> 0 Then errFLG = 1 ' GPIB remote enable
　e = GpDelim(1, 1): If e <> 0 Then errFLG = 1 ' Delimiter [1: CR+LF / 1: EOI valid]
　e = GpTimeout(2000): If e <> 0 Then errFLG = 1 ' Timeout (2000×1msec)
　e = GpSdc(Adr6485): If e <> 0 Then errFLG = 1 ' SDC (Select Device Clear)
　If errFLG = 1 Then
　　Text8.Text = "GP-IB Initialization Failed!"
　Else
　　Text8.Text = "GP-IB Initialization OK"
　End If
'---------------------------------------------------------------
　Cmd(0) = 1 ' トーカ数
　Cmd(1) = Adr6485 ' トーカアドレス
　ret = GpPoll(Cmd(0), Pstb(0)) ' ポーリング
　talker = Cmd(Pstb(0)) '
　stbyte = Pstb(Pstb(0)) '

　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr6485 ' listener address (6485)
' 　e = GpTalk(Cmd(0), 2, "F5") ' 測定レンジ（温度℃）
' 　e = GpTalk(Cmd(0), 2, "R0") ' 測定レンジ（Auto Range on 初期値）
' 　e = GpTalk(Cmd(0), 2, "S2") ' Sampling Speed (Fast）
'-----------------------------------------------------
'　 ret = GpGet(Adr6485) ' get
' 　If ret = 0 Then
' 　　CmdR(0) = 2 ' talker + listener
' 　　CmdR(1) = Adr6485 ' talker address (6485)
' 　　CmdR(2) = AdrComp ' listener address (GPIB)
' 　　e = GpListen(CmdR(0), 20, temp)
' 　　Text5.Text = Val(Mid$(temp, 4, 11))
' 　End If
' 　e = GpResetren()
'-----------------------------------------------------
　Timer1.Interval = 100 ' (100 msec)
　Timer1.Enabled = False
　ScaleH = 100: ScaleW = 2000
　BaseColor = Command2.BackColor
　Command3.Enabled = False
End Sub
'***************************************
Private Sub Command2_Click()
'***************************************
　Command2.Enabled = False
　Command3.Enabled = True
　Command2.BackColor = vbGreen
　Command3.BackColor = BaseColor
　Xmin = Val(Text6.Text)
　Xmax = Val(Text7.Text)
　Ymin = Val(Text3.Text)
　Ymax = Val(Text2.Text)
　e = GpRen() ' GPIB remote enable
　FLG = 0
　If Val(Text4.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\dummy.dat" For Output As #2

　Do
　　t(nCycle) = t(nCycle - 1) + Val(Text4.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 - (Tem(i - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　Y2 = ScaleH - (Tem(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　Picture1.Line (X1, Y1)-(X2, Y2), 6
　　　Next i
　　End If
　　If Tem(nCycle) > Ymax Then
　　　Ymax = Tem(nCycle)
　　　Text2.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 - (Tem(i - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Y2 = ScaleH - (Tem(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Picture1.Line (X1, Y1)-(X2, Y2), 6
　　　Next i
　　End If
　　If Tem(nCycle) < Ymin Then
　　　Ymin = Tem(nCycle)
　　　Text3.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 - (Tem(i - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　Y2 = ScaleH - (Tem(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()
　Command2.Enabled = True
End Sub
'********************************
Private Sub Command3_Click()
'********************************
　FLG = 1
　Command3.BackColor = vbRed
　Command2.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), Tem(k)
　　　Next k
　　　Beep
　　　MsgBox ("保存しました")
　　Close #1
　End If
　Command3.Enabled = False
　Call Meas
End Sub
'***********************************
Private Sub Meas()
'***********************************
　ret = GpGet(Adr6485) ' get
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = Adr6485 ' talker address (6485)
　　CmdR(2) = AdrComp ' listener address (GPIB)
　　e = GpListen(CmdR(0), 20, temp)
　　Text5.Text = Val(Mid$(temp, 4, 11))
　　Text1.Text = t(nCycle)
　　Tem(nCycle) = Val(Mid$(temp, 4, 11))
　　Print #2, t(nCycle), Tem(nCycle)
　　X1 = (t(nCycle - 1) - Xmin) / (Xmax - Xmin) * ScaleW
　　X2 = (t(nCycle) - Xmin) / (Xmax - Xmin) * ScaleW
　　Y1 = ScaleH - (Tem(nCycle - 1) - Ymin) / (Ymax - Ymin) * ScaleH
　　Y2 = ScaleH - (Tem(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(Text4.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 form_unload(cancel As Integer)
'***************************************
　e = GpResetren()
　e = GpExit()
End Sub
'**************************
Private Sub Timer1_Timer()
'**************************
　TimerCount = TimerCount + 0.1 ' (0.1 sec)
End Sub