Imports System.Text                     'Encodingのために定義


Public Class Form1


    Dim MsgBuf As String


    Dim MsgFlg As Integer

    Dim objExcel As Object      'EXCELのオブジェクト
    Dim objBook As Object       'ワークブックのオブジェクト
    Dim objSheet As Object      'ワークシートのオブジェクト
    Dim yHan As Long            'EXCELの凡例記入場所
    Dim xHan As Long            'EXCELの凡例記入場所
    Dim yLine As Long           'EXCELの記入場所
    Dim xLine As Long           'EXCELの記入場所
    Dim MAXUNIT As Long         '測定ユニット数
    Dim MAXCH As Long           '測定チャネル数
    Dim SAMPLE As Long          'データ取得間隔(単位ms)
    Dim MAXNUM As Long          '測定データ数
    Dim unit As Long
    Dim ch As Long
    Dim num As Long


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        '*******************************************************************************
        ' LAN SAMPLE PROGRAM NO.3
        '
        ' このプログラムは、本器に接続して各CHの値を取り込みEXCELに貼り付けます。
        '
        ' データ取得間隔は１秒より遅い間隔で設定できます。
        ' EXCELがインストールされている必要があります。
        ' WinAPIのGetTickCountを使用しています。
        ' 時間の管理はPC側で行っています。
        '
        ' 注意
        ' LR8450が測定 開始中 の時は、データを取得するコマンドを送った時、
        ' その前に測定したデータを返します。例えば、LR8450の記録間隔が
        ' 10秒であった場合、パソコン側から1秒毎データ取得コマンドを
        ' 10回送っても､10秒経つ間は同じデータが返ってきますので､1秒毎の
        ' データが必要な場合は､LR8450の記録間隔を1秒より早く設定して下さい。
        '
        ' LR8450が測定 停止中 の時は、データを取得するコマンドを送った時、
        ' その瞬間のデータを返します。
        ' なお、測定 停止中は、データを取得するのに、5秒程度かかるため、
        ' 取得間隔を1秒に設定しても、1秒ごとにEXCELは更新されません。
        '*******************************************************************************




        'EXCELのワークシートの選択
        On Error GoTo Err_Sheet
Chk_Err_Sheet:
        objSheet = objBook.worksheets(TextBox6.Text)
        GoTo No_Err_Sheet
Err_Sheet:


        On Error GoTo Err_Excel
Chk_Err_Excel:
        objSheet = objBook.worksheets.Add
        TextBox6.Text = objSheet.Name


No_Err_Sheet:


        'EXCELの凡例セルの選択
        On Error GoTo Err_Han
Chk_Err_Han:
        'EXCELのセルのyHanの初期化
        yHan = objSheet.Range(TextBox9.Text).Row
        'EXCELのセルのxHanの初期化
        xHan = objSheet.Range(TextBox9.Text).Column
        GoTo No_Err_Han
Err_Han:
        TextBox9.Text = "A1"
        GoTo Chk_Err_Han
No_Err_Han:



        'EXCELのセルの選択
        On Error GoTo Err_Cell
Chk_Err_Cell:
        'EXCELのセルのyLineの初期化
        yLine = objSheet.Range(TextBox7.Text).Row
        'EXCELのセルのxLineの初期化
        xLine = objSheet.Range(TextBox7.Text).Column
        GoTo No_Err_Cell
Err_Cell:
        TextBox7.Text = "A2"
        GoTo Chk_Err_Cell
No_Err_Cell:



        TextBox1.Text = "測定中"

        SAMPLE = (TextBox3.Text * 1000) 'データ取得間隔(単位ms)

        MAXUNIT = 1                  '測定ユニット数

        MAXCH = TextBox4.Text           '測定チャネル数

        MAXNUM = TextBox8.Text          '測定データ数


        num = 0                     'データ数カウンタ


        'LR8450の設定
        'HEADERをOFFにする
        SendMsgCrLf(":HEAD OFF")

        'タイム、チャネルの表示
        For unit = 1 To MAXUNIT
            For ch = 1 To MAXCH
                If (unit = 1 And ch = 1) Then
                    objSheet.Cells(yHan, xLine).Value = "時刻"
                End If
                objSheet.Cells(yHan, xHan + ((unit - 1) * MAXCH) + ch).Value = "CH" & unit & "_" & ch
            Next ch
        Next unit


        'タイマ動作開始（2回目以降のデータはタイマ間隔ごと取得）
        start_timer()

        '最初のデータ取得
        get_data()


        GoTo No_Err_Excel


Err_Excel:
        TextBox1.Text = "測定できません。Excelが起動されてますか？"


No_Err_Excel:

    End Sub


    Private Sub get_data()

        Dim RecciveStr As String     '受信文字列

        'LR8450へクエリコマンド送信
        ':MEMory:GETRealの保持完了を待ってから、:MEMory:VREAl?を行うため、*OPCを入れます。
        SendMsgCrLf(":MEM:GETREAL;*OPC")

        For unit = 1 To MAXUNIT
            For ch = 1 To MAXCH

                GetMsg2CrLf(":MEM:VREAL? CH" & unit & "_" & ch)

                'LR8450からクエリ受信
                RecciveStr = MsgBuf

                'EXCELに書き込む
                If (unit = 1 And ch = 1) Then
                    objSheet.Cells(yLine, xLine).Value = TimeOfDay
                End If
                objSheet.Cells(yLine, xLine + ((unit - 1) * MAXCH) + ch).Value = RecciveStr

            Next ch
        Next unit

        'セルをスクロール
        objSheet.Cells(yLine, 1).Show()

        '書き込み位置の更新
        yLine = yLine + 1
        TextBox7.Text = objSheet.Cells(yLine, xLine).address(rowAbsolute:=False, columnAbsolute:=False)

        'データ数カウンタ更新
        num = num + 1


        'データ数チェック
        If MAXNUM <> 0 And MAXNUM = num Then
            stop_timer()
        End If

    End Sub


    Private Sub start_timer()

        'タイマ動作開始
        Timer1.Interval = SAMPLE
        Timer1.Enabled = True

    End Sub


    Private Sub stop_timer()

        'タイマ動作停止
        Timer1.Enabled = False

        TextBox1.Text = "測定終了"

    End Sub


    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

        'タイマ間隔ごとデータを取得
        get_data()

    End Sub


    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        '停止ボタン
        stop_timer()

    End Sub


    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        'EXCELを起動します
        objExcel = CreateObject("Excel.application")

        objExcel.Visible = True

        'EXCELのワークブックの選択
        On Error GoTo Err_Book
Chk_Err_Book:
        objBook = objExcel.workbooks.open(TextBox5.Text)
        GoTo No_Err_Book
Err_Book:
        objBook = objExcel.workbooks.Add
        TextBox5.Text = "c:\" + objBook.Name
No_Err_Book:

    End Sub


    Private Sub Form_Load()

        'プログラム実行時に設定した値を覚えさせて、次回実行時に同じ設定を使う場合は下記を有効にしてください
        '    textSerial = GetSetting("samp3", "Startup", "Set1", "0")
        '    TextBox3 = GetSetting("samp3", "Startup", "Set3", "1")
        '    TextBox4 = GetSetting("samp3", "Startup", "Set4", "15")
        '    TextBox5 = GetSetting("samp3", "Startup", "Set5", "c:\Book1")
        '    TextBox6 = GetSetting("samp3", "Startup", "Set6", "Sheet1")
        '    TextBox7 = GetSetting("samp3", "Startup", "Set7", "A2")
        '    TextBox8 = GetSetting("samp3", "Startup", "Set8", "0")
        '    TextBox9 = GetSetting("samp3", "Startup", "Set9", "A1")

    End Sub


    Private Sub Form_Unload(ByVal Cancel As Integer)

        'オブジェクトの解放
        objExcel = Nothing
        objBook = Nothing
        objSheet = Nothing

        'プログラム実行時に設定した値を覚えさせて、次回実行時に同じ設定を使う場合は下記を有効にしてください
        '    SaveSetting "samp3", "Startup", "Set1", textSerial
        '    SaveSetting "samp3", "Startup", "Set3", TextBox3
        '    SaveSetting "samp3", "Startup", "Set4", TextBox4
        '    SaveSetting "samp3", "Startup", "Set5", TextBox5
        '    SaveSetting "samp3", "Startup", "Set6", TextBox6
        '    SaveSetting "samp3", "Startup", "Set7", TextBox7
        '    SaveSetting "samp3", "Startup", "Set8", TextBox8
        '    SaveSetting "samp3", "Startup", "Set9", TextBox9

    End Sub


    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        SerialPort1.PortName = TextCom.Text                    'ポートを指定
        SerialPort1.Open()                                     '接続

        TextBox2.Text = "USB接続完了"

    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        SerialPort1.Close()                                    '切断

        TextBox2.Text = "USB切断完了"

    End Sub

    Private Sub SendMsgCrLf(ByVal strMsg As String)

        strMsg = strMsg & vbCrLf
        SerialPort1.WriteLine(strMsg)                          'ﾒｯｾｰｼﾞ送信

    End Sub

    Private Sub GetMsg2CrLf(ByVal strMsg As String)

        strMsg = strMsg & vbCrLf
        SerialPort1.WriteLine(strMsg)                          'ﾒｯｾｰｼﾞ送信

        Dim Check As Integer
        MsgBuf = Nothing
        Do                                                     '応答受信まで待つ
            Check = SerialPort1.ReadByte()
            If Chr(Check) = vbLf Then
                Exit Do
            ElseIf Chr(Check) = vbCr Then
            Else
                MsgBuf = MsgBuf & Chr(Check)
            End If
        Loop

    End Sub

    Private Sub TextBox5_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBox5.TextChanged

    End Sub

    Private Sub Label3_Click(sender As System.Object, e As System.EventArgs) Handles Label3.Click

    End Sub

    Private Sub Label10_Click(sender As System.Object, e As System.EventArgs) Handles Label10.Click

    End Sub

    Private Sub TextBox3_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBox3.TextChanged

    End Sub
End Class
