Dim BaseColor As Long, Trans_Time As Single
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 Cmd(31) As Long, 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, AdrVOAC As Integer
Dim UserName As String
　Private Sub Form_Load()
　Form2.Show
　AdrComp = 0 ' Computer Address
　AdrVOAC = 15 ' VOAC7412 Multimeter Address
' 　AdrVOAC = 5 ' VOAC7413 Multimeter Address
　UserName = "abe"
'---------------------------------------------------------------
　e1 = GpIni() ' GPIB 初期化
　e2 = GpIfc(1) ' インターフェイスクリア (1×100μsec)
　e3 = GpRen() ' GPIB remote enable
　If e1 <> 0 Then Form2.Text1.Text = "GP-IB Initialization Failed" Else Form2.Text1.Text = "GP-IB Initialization OK"
　If e2 <> 0 Then Form2.Text2.Text = "Interface Clear Failed" Else Form2.Text2.Text = "Interface Clear OK"
　If e3 <> 0 Then Form2.Text3.Text = "GP-IB Remote Enable Failed" Else Form2.Text3.Text = "GP-IB Remote Enable OK"
　Cmd(0) = 1 ' トーカ数
　Cmd(1) = AdrVOAC ' トーカアドレス
　e4 = GpPoll(Cmd(0), Pstb(0)) ' ポーリング
　talker = Cmd(Pstb(0)) '
　stbyte = Pstb(Pstb(0)) '
　If e4 <> 0 Then Form2.Text4.Text = "Polling Failed => " & e4 Else Form2.Text4.Text = "Polling OK"
　e5 = GpDelim(1, 1) ' Delimiter [1: CR+LF / 1: EOI valid]
　e6 = GpTimeout(2000) ' Timeout (2000×1msec)
　e7 = GpSdc(AdrVOAC) ' SDC (Select Device Clear)
　If e5 <> 0 Then Form2.Text5.Text = "Delimiter Failed" Else Form2.Text5.Text = "Delimiter OK"
　If e6 <> 0 Then Form2.Text6.Text = "Timeout Failed" Else Form2.Text6.Text = "Timeout OK"
　If e7 <> 0 Then Form2.Text7.Text = "Select Device Clear Failed" Else Form2.Text7.Text = "Select Device Clear OK"
'---------------------------------------------------------------
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = AdrVOAC ' listener address (VOAC7412)
　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(AdrVOAC) ' get
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = AdrVOAC ' talker address (VOAC7412)
　　CmdR(2) = AdrComp ' listener address (GPIB)
　　e = GpListen(CmdR(0), 20, temp)
　　Text5.Text = Val(Mid$(temp, 4, 11))
　　Tem(0) = Val(Mid$(temp, 4, 11))
　End If
　e = GpResetren()
'-----------------------------------------------------
　Trans_Time = 0.22 ' (sec)
　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 "C:\User\" + UserName + "\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, Time$, t(k), Tem(k)
　　　Next k
　　　Beep
　　　MsgBox (FileName & " 保存しました")
　　Close #1
　End If
　Command3.Enabled = False
　Call Meas
End Sub

Private Sub Meas()
　ret = GpGet(AdrVOAC) ' get
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = AdrVOAC ' talker address (VOAC7412)
　　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) - Trans_Time) ' 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)
　Unload Form2
　e = GpResetren()
　e = GpExit()
End Sub

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