Dim BaseColor As Long
Dim talker As Long, stbyte As Long
Dim TimerCount As Single, FLG As Integer
Dim nD As Integer, nP As Integer, Rsize As Single
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 Disp As String * 100
Dim Freq(1000), DispA(1000) As Single, DispB(1000) As Single
Dim AdrComp As Integer, AdrHP As Integer
'***********************************************************
Private Sub Form_Load()
'***********************************************************
　Form2.Show
　AdrComp = 0 ' Computer Address
　AdrHP = 17 ' HP 4276A LCZ Meter Address
'　---------------------------------------------------------------
　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) = AdrHP ' トーカアドレス
　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.Text3.Text = "Polling OK"
　e5 = GpDelim(1, 1) ' Delimiter [1: CR+LF / 1: EOI valid]
　e6 = GpTimeout(2000) ' Timeout (2000×1msec)
　e7 = GpSdc(AdrHP) ' 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) = AdrHP ' listener address (VOAC7412)
　e = GpTalk(Cmd(0), 2, "A2") ' 測定モード C
　e = GpTalk(Cmd(0), 2, "B3") ' 測定モード G
　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()
'***********************************************************************************
　Picture1.Cls
　Command2.Enabled = False
　Command3.Enabled = True
　Command2.BackColor = vbGreen
　Command3.BackColor = BaseColor
　nD = Val(Text8.Text)
　Xmin = Val(Text6.Text)
　Xmax = Val(Text7.Text)
　Ymin = Val(Text3.Text)
　Ymax = Val(Text2.Text)
　Rsize = ScaleW / nD / 10
' ++++++++++++++
　Call Scale_Log ' Log - scale
' ++++++++++++++
　e = GpRen() ' GPIB remote enable
　FLG = 0
'　---------------------------------------------------------
　If nD < 1 Then
　　Beep
　　e = MsgBox("DATA points < 1", 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
'　----------------------------------------------
　Freq(1) = 0.1
　k = 1
　For i = 1 To nD
　　k = k + 1
　　F = 0.1 * 10 ^ (i / nD)
　　Freq(k) = Int(F * 100 + 0.5) / 100
　Next i
　For i = 1 To nD
　　k = k + 1
　　F = 10 ^ (i / nD)
　　Freq(k) = Int(F * 100 + 0.5) / 100
　Next i
　Freq(k + 1) = 20
　nP = k + 1
　Picture1.FillStyle = 0
'--------------------------------------------------
　Open "B:\Abe\project_VB\hp4276A\dummy.dat" For Output As #2
　　For k = 1 To nP
' 　　+++++++++++
　　　Call Meas(k)
' 　　+++++++++++
　　　If DispA(k) > Ymax Then
　　　　Ymax = DispA(k)
　　　　Text2.Text = Ymax
　　　　Picture1.Cls
　　　　Picture1.FillColor = RGB(255, 0, 0)
' 　　　++++++++++++++
　　　　Call Scale_Log ' Log - scale
' 　　　++++++++++++++
　　　　For i = 1 To k
　　　　　X1 = (Log(Freq(i)) - Log(Xmin)) / (Log(Xmax) - Log(Xmin)) * ScaleW
　　　　　Y1 = ScaleH - (DispA(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Picture1.Circle (X1, Y1), Rsize, RGB(255, 0, 0)
　　　　Next i
　　　End If
　　　If DispA(k) < Ymin Then
　　　　Ymin = DispA(k)
　　　　Text3.Text = Ymin
　　　　Picture1.Cls
　　　　Picture1.FillColor = RGB(255, 0, 0)
　　　　For i = 1 To k
　　　　　X1 = (Log(Freq(i)) - Log(Xmin)) / (Log(Xmax) - Log(Xmin)) * ScaleW
　　　　　Y1 = ScaleH - (DispA(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　　Picture1.Circle (X1, Y1), Rsize, RGB(255, 0, 0)
　　　　Next i
　　　End If
　　　If FLG = 1 Then Exit For
　　Next k
　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 nP
　　　　Print #1, Freq(k), DispA(k), DispB(k)
　　　Next k
　　　Beep
　　　MsgBox (FileName & " 保存しました")
　　Close #1
　End If
　Command3.Enabled = False
　Call Meas(k)
End Sub
'***********************************************************************************
Private Sub Meas(k)
'***********************************************************************************
' ++++++++++++++
　Call Scale_Log ' Log - scale
' ++++++++++++++
　F$ = "FR" + Str$(Freq(k)) + "EN"
　L = Len(F$)
　e = GpTalk(Cmd(0), L, F$)
'　-----------------------------------------------------
　ret = GpGet(AdrHP) ' get
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = AdrHP ' talker address (VOAC7412)
　　CmdR(2) = AdrComp ' listener address (GPIB)
　　e = GpListen(CmdR(0), 28, Disp)
　　DispA(k) = Val(Mid$(Disp, 4, 11))
　　DispB(k) = Val(Mid$(Disp, 18, 11))
　　Text1.Text = Freq(k)
　　Text4.Text = DispA(k)
　　Text5.Text = DispB(k)
　　Print #2, Freq(k), DispA(k), DispB(k)
　　X1 = (Log(Freq(k)) - Log(Xmin)) / (Log(Xmax) - Log(Xmin)) * ScaleW
　　Y1 = ScaleH - (DispA(k) - Ymin) / (Ymax - Ymin) * ScaleH
　　Picture1.FillColor = RGB(255, 0, 0)
　　Picture1.Circle (X1, Y1), Rsize, RGB(255, 0, 0)
　ElseIf ret >= 252 Then
　　Text4.Text = "Error"
　　e = GpResetren()
　　e = GpExit()
　　End
　End If
' +++++++++++++++++++++++++++
　Call delay(Val(Text4.Text)) ' Sampling time
' +++++++++++++++++++++++++++
End Sub
'***********************************************************************************
Private Sub Scale_Log()
'***********************************************************************************
　dx = 0.1
　X = Xmin
　Do
　　For i = 1 To 9
　　　X1 = (Log(X) - Log(Xmin)) / (Log(Xmax) - Log(Xmin)) * ScaleW
　　　If i = 1 Then
　　　　Picture1.Line (X1, ScaleH)-(X1, ScaleH - 4), 6
　　　　Picture1.Line (X1, 0)-(X1, 4), 6
　　　Else
　　　　Picture1.Line (X1, ScaleH)-(X1, ScaleH - 2), 6
　　　　Picture1.Line (X1, 0)-(X1, 2), 6
　　　End If
　　　X = X + dx
　　Next i
　　dx = dx * 10
　Loop While X < Xmax
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