Dim BaseColor As Long, Trans_Time As Single
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 temp As String * 100, t(50000) As Single
Dim tm$(50000), sec(50000)
Dim Tem1(50000) As Single, Tem2(50000) As Single
Dim DA(50000) As Single, DB(50000) As Single, Freq(50000) As Single
Dim AdrComp As Integer, AdrVOAC As Integer, AdrF250 As Integer
Dim Adr2340 As Integer, nF As Integer
Dim MeasCond As String, Nyu As String * 20
Dim L As Long, FILEout As String * 50, CK As String * 5
Dim FF As String, FE As String, SP As String * 5, BV As String
　Private Sub Form_Load()
　Form2.Show
　Form3.Show
　AdrComp = 0 ' Computer Address
　AdrVOAC = 5 ' VOAC7413 Multimeter Address (Photo diode)
　AdrF250 = 2 ' F250 Address (Temperature Monitor1)
　Adr2340 = 9 ' CS-5370P Address (Transducer)
'----------------------------------------------------------------------
　e1 = GpIni() ' GPIB 初期化
　e2 = GpIfc(1) ' インターフェイスクリア (1×100μsec)
　e3 = GpDelim(1, 1) ' デリミタ (CR+LF, EOI on)
　e4 = GpRen() ' GPIB remote enable
　e5 = GpTimeout(2000) ' Timeout (2000×1msec)
　e6 = GpSdc(Adr5370): ' SDC (Select Device Clear)
　e7 = GpSdc(Adr2340): ' 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 (F250) OK" Else Form2.Text6.Text = "Select Device Clear (F250) Failed"
　If e7 = 0 Then Form2.Text7.Text = "Select Device Clear (2340) OK" Else Form2.Text7.Text = "Select Device Clear (2340) Failed"
'------------------------------------------------------------
　Call T_MON1(0)
　Call T_MON2(0)
'-------------------------------------------------------------
　Text9.Text = "1000"
' LCZ meter
　MeasCond = "FR 1E3;VI 0;LV 1; RN 0;SP 1;TR 1;DL 0" 'FR: frequency
　L = Len(MeasCond) 'SP: 1 MED speed
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr2340 ' listener address (2340)
　e = GpTalk(Cmd(0), L, MeasCond) ' 測定条件

　MeasCond = "DA 1;DB 3;DE 0;CM 0;CK 2;TG" 'DA: display A (1: C)
　L = Len(MeasCond) 'DB: display B (3: G)
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr2340 ' listener address (2340)
　e = GpTalk(Cmd(0), L, MeasCond) ' 測定条件
　ret = GpGet(Adr2340) ' get
'--------------------------------------------------------------------------
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = Adr2340 ' talker address (2340)
　　CmdR(2) = AdrComp ' listener address (GPIB)
　　e = GpListen(CmdR(0), 23, temp)
　　Text10.Text = Val(Left$(temp, 11))
　　Text11.Text = Val(Mid$(temp, 13, 11))
　　Freq(0) = 9
　　DA(0) = Val(Left$(temp, 11))
　End If
'-----------------------------------------------------------------
　Form3.Check1.Value = 1
　Form3.Check2.Value = 1
　Form3.Check3.Value = 1
　Form3.Check4.Value = 1
　Form3.Check5.Value = 1
　Option1.Value = 1
'----------------------------------------------------------------
　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.BackColor = vbGreen
　Command2.Enabled = False
　Command3.Enabled = True
　FLG = 0
　k = 0
　If Form3.Check1.Value = 1 Then
　　Fs = Val(Form3.Text1.Text): FE = Val(Form3.Text2.Text)
　　dF = Val(Form3.Text3.Text)
　　Call ck_RG(1, Fs, FE, dF, k)
　　If FLG = 1 Then Exit Sub
　End If
　If Form3.Check2.Value = 1 Then
　　Fs = Val(Form3.Text4.Text): FE = Val(Form3.Text5.Text)
　　dF = Val(Form3.Text6.Text)
　　Call ck_RG(2, Fs, FE, dF, k)
　　If FLG = 1 Then Exit Sub
　End If
　If Form3.Check3.Value = 1 Then
　　Fs = Val(Form3.Text7.Text): FE = Val(Form3.Text8.Text)
　　dF = Val(Form3.Text9.Text)
　　Call ck_RG(3, Fs, FE, dF, k)
　　If FLG = 1 Then Exit Sub
　End If
　If Form3.Check4.Value = 1 Then
　　Fs = Val(Form3.Text10.Text): FE = Val(Form3.Text11.Text)
　　dF = Val(Form3.Text12.Text)
　　Call ck_RG(4, Fs, FE, dF, k)
　　If FLG = 1 Then Exit Sub
　End If
　If Form3.Check5.Value = 1 Then
　　Fs = Val(Form3.Text13.Text): FE = Val(Form3.Text14.Text)
　　dF = Val(Form3.Text15.Text)
　　Call ck_RG(5, Fs, FE, dF, k)
　　If FLG = 1 Then Exit Sub
　End If
　nF = k
　Xmin = Freq(1)
　Xmax = Freq(nF)
　Text6.Text = Freq(1)
　Text7.Text = Freq(nF)
　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 Ymax <= Ymin Then
　　Beep
　　e = MsgBox("Ymin > Ymax", vbOKOnly, "警告")
　　Exit Sub
　End If
　Picture1.Cls
　Call scale_log
'--------------------------------------------------
　nCycle = 1
　If Option1.Value = True Then
　　FILEout = "A:\User\abe\project_VB\Transducer\dummy.dat"
　　Call Meas
　Else
　　Beep
　　e = MsgBox("データを保存しますか？", vbYesNo, "確認")
　　If e = 6 Then
　　　On Error Resume Next
　　　CommonDialog1.CancelError = True
　　　CommonDialog1.Filter = "データファイル(*.seq)|*.seq|" & "すべてのファイル(*.*)|*.*|"
　　　CommonDialog1.FilterIndex = 1
　　　CommonDialog1.DefaultExt = "SEQ"
　　　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
　　End If
' ---------------------------------
　　t0 = 3600 * Val(Left$(Time$, 2)) + 60 * Val(Mid$(Time$, 4, 2)) + Val(Right$(Time$, 2))
　　For nCycle = 1 To 999
　　　Text12.Text = nCycle
　　　Picture1.Cls
　　　Call scale_log
　　　L1 = Len(FileName)
　　　L2 = Len(Str$(nCycle)) - 1
　　　If L2 = 1 Then Scan = "00" + Right$(Str$(nCycle), L2)
　　　If L2 = 2 Then Scan = "0" + Right$(Str$(nCycle), L2)
　　　If L2 = 3 Then Scan = Right$(Str$(nCycle), L2)
　　　FILEout = Left$(FileName, L1 - 4) + "_" + Scan + ".seq"
　　　Call Meas
　　　Text1.Text = 3600 * Val(Left$(Time$, 2)) + 60 * Val(Mid$(Time$, 4, 2)) + Val(Right$(Time$, 2)) - t0
　　　Call delay(Val(Text4.Text)) ' Interval time
　　Next nCycle
　End If
'---------------------------------------------------------------------
　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
　　L = Len(FileName)
　　FF = Left$(FileName, L - 4)
　　FE = Right$(FileName, 4)
　　FileName = FF + CK + SP + FE

　　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
　　　Print #1, Tem1(nCycle), Tem2(nCycle), "Bias="; BV; "[V]"
　　　For k = 1 To nF
　　　　Print #1, Freq(k), DA(k), DB(k)
　　　Next k
　　　Beep
　　　MsgBox (FileName & " 保存しました")
　　Close #1
　End If
　Command3.Enabled = False
　Command3.BackColor = BaseColor
End Sub

Private Sub Meas()
　If Combo1.Text = "AUTO" Then MeasCond = "CK 0": CK = "_auto"
　If Combo1.Text = "SERI" Then MeasCond = "CK 1": CK = "_seri" ' Serial
　If Combo1.Text = "PARA" Then MeasCond = "CK 2": CK = "_para" ' Pararel
　L = Len(MeasCond)
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr2340 ' listener address (2340)
　e = GpTalk(Cmd(0), L, MeasCond) ' 測定条件
'--------------------------------------------------------------
　If Combo2.Text = "FAST" Then MeasCond = "SP 0": SP = "_fast"
　If Combo2.Text = "MED" Then MeasCond = "SP 1": SP = "_med"
　If Combo2.Text = "SLOW" Then MeasCond = "SP 2": SP = "_slow"
　L = Len(MeasCond)
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr2340 ' listener address (2340)
　e = GpTalk(Cmd(0), L, MeasCond) ' 測定条件
'---------------------------------------------------------------
　BV = Text13.Text
　MeasCond = "BV " + BV
　L = Len(MeasCond)
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = Adr2340 ' listener address (2340)
　e = GpTalk(Cmd(0), L, MeasCond) ' 測定条件
'----------------------------------
　Open FILEout For Output As #2
　　Call T_MON1(nCycle)
　　Call T_MON2(nCycle)
　　Print #2, Date$, Time$
　　Print #2, Tem1(nCycle), Tem2(nCycle), "Bias="; BV; "[V]"
　　Min = 100000: Max = -100000
　　For i = 1 To nF
　　　Text9.Text = Freq(i)
　　　LL = Len(Str$(Freq(i))) - 2
　　　f = Freq(i) / 10 ^ LL
　　　MM = Len(Str$(LL))
　　　Nyu = Mid$(Str$(f), 2, 3) + "E" + Right(Str$(LL), MM - 1)
　　　MeasCond = "FR " + Nyu
　　　L = Len(MeasCond)
　　　Cmd(0) = 2 ' talker + listener
　　　Cmd(1) = AdrComp ' talker address (GPIB)
　　　Cmd(2) = Adr2340 ' listener address (2340)
　　　e = GpTalk(Cmd(0), L, MeasCond) ' 測定条件
　　　ret = GpGet(Adr2340) ' get
　　　If ret = 0 Then
　　　　CmdR(0) = 2 ' talker + listener
　　　　CmdR(1) = Adr2340 ' talker address (2340)
　　　　CmdR(2) = AdrComp ' listener address (GPIB)
　　　　e = GpListen(CmdR(0), 23, temp)
　　　　Text10.Text = Left$(temp, 11)
　　　　Text11.Text = Mid$(temp, 13, 11)
　　　　DA(i) = Val(Left$(temp, 11))
　　　　DB(i) = Val(Mid$(temp, 13, 11))
　　　　If Max < DA(i) Then Max = DA(i)
　　　　If Min > DA(i) Then Min = DA(i)
　　　　X = (Log(Freq(i)) - Log(Xmin)) / (Log(Xmax) - Log(Xmin)) * ScaleW
　　　　Y = ScaleH - (DA(i) - Ymin) / (Ymax - Ymin) * ScaleH
　　　　If Ymin <= DA(i) And DA(i) <= Ymax Then Picture1.Circle (X, Y), 6, RGB(255, 0, 0)
　　　End If
　　　Print #2, Freq(i), DA(i), DB(i)
　　Next i
　Close #2
'--------------------------------
　Text3.Text = Min
　Text2.Text = Max
　Ymin = Min
　Ymax = Max
　If Ymin >= Ymax Then Ymax = 1
　Picture1.Cls
　Call scale_log
　For i = 1 To nF
　　X = (Log(Freq(i)) - Log(Xmin)) / (Log(Xmax) - Log(Xmin)) * ScaleW
　　Y = ScaleH - (DA(i) - Ymin) / (Ymax - Ymin) * ScaleH
　Picture1.Circle (X, Y), 6, RGB(255, 0, 0)
　Next i
End Sub

Private Sub T_MON1(n) ' Temperature Monitor 1
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = AdrF250 ' listener address (F250)
　ret = GpTalk(Cmd(0), 1, "T") ' Reading
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = AdrF250 ' talker address (F250)
　　CmdR(2) = AdrComp ' listener address (GPIB)
　　e = GpListen(CmdR(0), 9, temp)
　　Text5.Text = Val(Mid$(temp, 2, 7))
　　Tem1(n) = Val(Mid$(temp, 2, 7))
　End If
End Sub

Private Sub T_MON2(n) ' Temperature Monitor 2
　Cmd(0) = 2 ' talker + listener
　Cmd(1) = AdrComp ' talker address (GPIB)
　Cmd(2) = AdrVOAC ' listener address (VOAC7413)
　e = GpTalk(Cmd(0), 2, "F5") ' 測定レンジ（温度℃）
' 　e = GpTalk(Cmd(0), 2, "S2") ' Sampling Speed (Fast）
' 　e = GpTalk(Cmd(0), 2, "S0") ' Sampling Speed (Slow）
　e = GpTalk(Cmd(0), 2, "S1") ' Sampling Speed (mid）
　ret = GpGet(AdrVOAC) ' get
　If ret = 0 Then
　　CmdR(0) = 2 ' talker + listener
　　CmdR(1) = AdrVOAC ' talker address (VOAC7413)
　　CmdR(2) = AdrComp ' listener address (GPIB)
　　e = GpListen(CmdR(0), 20, temp)
　　Text8.Text = Val(Mid$(temp, 4, 11))
　　Tem2(n) = Val(Mid$(temp, 4, 11))
　End If
End Sub

Private Sub ck_RG(nRG, Fs, FE, dF, k)
　If Fs <= 0 Then
　　Beep
　　e = MsgBox("Range" + Str$(nRG) + ": [Fs <0]", vbOKOnly, "警告")
　　Command2.BackColor = BaseColor
　　Command2.Enabled = True
　　Command3.Enabled = False
　　FLG = 1
　　Exit Sub
　End If
　If Fs > FE Then
　　Beep
　　e = MsgBox("Range" + Str$(nRG) + ": [Fs > Fe]", vbOKOnly, "警告")
　　Command2.BackColor = BaseColor
　　Command2.Enabled = True
　　Command3.Enabled = False
　　FLG = 1
　　Exit Sub
　End If
　If dF <= 0 Then
　　Beep
　　e = MsgBox("Range" + Str$(nRG) + ": [Step < 0]", vbOKOnly, "警告")
　　Command2.BackColor = BaseColor
　　Command2.Enabled = True
　　Command3.Enabled = False
　　FLG = 1
　　Exit Sub
　End If
　nF = (FE - Fs) / dF + 1
　f = Fs
　For i = k + 1 To nF + k
　　Freq(i) = f
　　f = f + dF
　Next i
　k = k + nF
End Sub

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

Private Sub scale_log()
　L = Len(Str$(Xmin))
　dx = 10 ^ (L - 2)
　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, 100)-(X1, 96), 6
　　　　Picture1.Line (X1, 0)-(X1, 4), 6
　　　Else
　　　　Picture1.Line (X1, 100)-(X1, 98), 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 form_unload(cancel As Integer)
　Unload Form2
　Unload Form3
　e = GpResetren()
　e = GpExit()
End Sub

Private Sub Option1_Click()
　If Option1.Value = 1 Then
　　Option1.Value = 0
　　Option2.Value = 1
　End If
End Sub

Private Sub Option2_Click()
　If Option2.Value = 1 Then
　　Option2.Value = 0
　　Option1.Value = 1
　End If
End Sub

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