サンプルプログラム > アナログ入力 > AiEvent >

Visual Basic 6.0¶

開発環境の設定¶

Ydx.bas をプロジェクトフォルダにコピーします。
Ydx.bas をプロジェクトに追加します。

コントロール¶

定義¶

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Const INFINITE = &HFFFF

変数¶

Dim id As Long
Dim result As Long

実行結果の表示¶

Private Sub ResultShow(ByVal title As String, ByVal resultCode As Long)
    Dim resultString As String
    Call YdxCnvResultToString(resultCode, resultString)
    Select Case resultCode
        Case 0, Ydx.YDX_RESULT_AI_EXCEED_DATA_NUM, Ydx.YDX_RESULT_AI_EXCEED_BUF_SIZ
            MsgBox resultString, vbInformation, title
        Case Else
            MsgBox resultString, vbCritical, title
    End Select

フォームロード¶

Private Sub Form_Load()
    ' ユニット識別スイッチ
    cboUnitSwitch.AddItem "0"
    cboUnitSwitch.AddItem "1"
    cboUnitSwitch.AddItem "2"
    cboUnitSwitch.AddItem "3"
    cboUnitSwitch.AddItem "4"
    cboUnitSwitch.AddItem "5"
    cboUnitSwitch.AddItem "6"
    cboUnitSwitch.AddItem "7"
    cboUnitSwitch.AddItem "8"
    cboUnitSwitch.AddItem "9"
    cboUnitSwitch.AddItem "A"
    cboUnitSwitch.AddItem "B"
    cboUnitSwitch.AddItem "C"
    cboUnitSwitch.AddItem "D"
    cboUnitSwitch.AddItem "E"
    cboUnitSwitch.AddItem "F"
    cboUnitSwitch.ListIndex = 0

    ' 型名
    cboModelName.AddItem "AIO-64/4/1B-USC"
    cboModelName.AddItem "AIO-60/4/1B-USC"
    cboModelName.ListIndex = 0

    ' レンジ
    cboRangeType.AddItem "-10 ～ +10V"
    cboRangeType.AddItem "-5 ～ +5V"
End Sub

オープン¶

Private Sub cmdOpen_Click()
    result = YdxOpen(cboUnitSwitch.ListIndex, cboModelName.Text, 0, id)
    If result <> 0 Then
        Call ResultShow("YdxOpen", result)
    Else
        cboUnitSwitch.Enabled = False
        cboModelName.Enabled = False
        cboRangeType.ListIndex = 0
        Call ResultShow("オープン", result)
    End If
End Sub

レンジ切り替え¶

Private Sub cboRangeType_Click()
    result = YdxAiSetRange(id, cboRangeType.ListIndex)
    If result <> 0 Then
        Call ResultShow("YdxAiSetRange", result)
    End If
End Sub

入力開始¶

Private Sub cmdStart_Click()
    txtData.Text = ""
    DoEvents

    ' データバッファの設定
    result = YdxAiSetBuffer(id, 0)   ' FIFOバッファ
    If result <> 0 Then
        Call ResultShow("YdxAiSetBuffer", result)
        Exit Sub
    End If

    ' チャネルの設定
    Const CHANNEL_NUM As Long = 6  ' 6チャネルを有効にする
    Dim channel As Long
    For channel = 0 To CHANNEL_NUM - 1
        result = YdxAiSetChannel(id, channel, 1)
        If result <> 0 Then
            Call ResultShow("YdxAiSetChannel", result)
            Exit Sub
        End If
    Next

    ' サンプリングクロックの設定
    result = YdxAiSetClock(id, 0)    ' 内部クロック
    If result <> 0 Then
        Call ResultShow("YdxAiSetClock", result)
        Exit Sub
    End If

    ' 内部クロック周期の設定
    result = YdxAiSetClockInternal(id, 1000) ' 1000μsec
    If result <> 0 Then
        Call ResultShow("YdxAiSetClockInternal", result)
        Exit Sub
    End If

    ' サンプリング開始条件の設定
    result = YdxAiSetStartCondition(id, 0, 0)   ' ソフトウェア
    If result <> 0 Then
        Call ResultShow("YdxAiSetStartCondition", result)
        Exit Sub
    End If

    ' サンプリング停止条件の設定
    result = YdxAiSetStopCondition(id, 0, 0)    ' サンプル数
    If result <> 0 Then
        Call ResultShow("YdxAiSetStopCondition", result)
        Exit Sub
    End If

    ' サンプリング停止条件（サンプル数）の設定
    Const SAMPLE_NUM As Long = 1000    ' 1000個
    result = YdxAiSetStopSampleNum(id, SAMPLE_NUM)
    If result <> 0 Then
        Call ResultShow("YdxAiSetStopSampleNum", result)
        Exit Sub
    End If

    ' データをクリア
    result = YdxAiClearData(id)
    If result <> 0 Then
        Call ResultShow("YdxAiClearData", result)
        Exit Sub
    End If

    ' イベントオブジェクト作成
    Dim hEvent As Long
    hEvent = CreateEvent(0, True, False, 0)
    If hEvent = 0 Then
        MsgBox "イベントオブジェクトの作成に失敗しました", vbCritical
        Exit Sub
    End If

    ' イベントの設定
    result = YdxAiSetEvent(id, _
        YDX_EVENT_COMMUNICATE_ERR Or _
        YDX_EVENT_HARDWARE_ERR Or _
        YDX_EVENT_OVERRUN_ERR Or _
        YDX_EVENT_SAMPLE_CLOCK_ERR Or _
        YDX_EVENT_STOP, _
        hEvent)
    If result <> 0 Then
        Call ResultShow("YdxAiSetEvent", result)
        CloseHandle hEvent
        Exit Sub
    End If

    ' アナログ入力動作を開始
    result = YdxAiStart(id)
    If result <> 0 Then
        Call ResultShow("YdxAiStart", result)
        CloseHandle hEvent
        Exit Sub
    End If

    ' イベント発生待ち
    Call WaitForSingleObject(hEvent, INFINITE)
    CloseHandle hEvent

    ' ステータスの取得
    Dim factor, sampleCount, repeatCount As Long
    result = YdxAiGetEventStatus(id, factor, sampleCount, repeatCount)
    If result <> 0 Then
        Call ResultShow("YdxAiGetEventStatus", result)
        Exit Sub
    End If

    If (factor And YDX_STATUS_COMMUNICATE_ERR) <> 0 Then
        MsgBox "通信エラーが発生しました", vbCritical
        Exit Sub
    End If

    If (factor And YDX_STATUS_HARDWARE_ERR) <> 0 Then
        MsgBox "ハードウェアエラーが発生しました", vbCritical
        Exit Sub
    End If

    If (factor And YDX_STATUS_OVERRUN_ERR) <> 0 Then
        MsgBox "オーバランエラーが発生しました", vbCritical
        Exit Sub
    End If

    If (factor And YDX_STATUS_SAMPLE_CLOCK_ERR) <> 0 Then
        MsgBox "サンプリングクロックエラーが発生しました", vbCritical
        Exit Sub
    End If

    ' データの読み出し
    Dim data(SAMPLE_NUM * CHANNEL_NUM) As Single   ' データ個数は、サンプル数 * 有効チャネル数
    Dim sampleNum As Long
    sampleNum = SAMPLE_NUM
    result = YdxAiGetDataVolt(id, sampleNum, data(0))
    If result <> 0 Then
        Call ResultShow("YdxAiGetDataVolt", result)
        If result <> YDX_RESULT_AI_EXCEED_DATA_NUM And result <> YDX_RESULT_AI_EXCEED_BUF_SIZ Then
            Exit Sub
        End If
    End If

    ' 表示
    Dim txt As String
    txt = "    "
    For channel = 0 To CHANNEL_NUM - 1
        txt = txt + "      CH" + Format(channel)
    Next

    txt = txt + vbCrLf
    Dim sampleIndex As Long
    For sampleIndex = 0 To sampleNum - 1
        txt = txt + Right("   " + Str(sampleIndex + 1), 5) + " : "
        For channel = 0 To CHANNEL_NUM - 1
            txt = txt + Right(" " & Format(data(sampleIndex * CHANNEL_NUM + channel), " 0.000;-0.000"), 7) + "V "
        Next
        txt = txt + vbCrLf
    Next

    txtData.Text = txt
End Sub

クローズ¶

Private Sub cmdClose_Click()
    cboUnitSwitch.Enabled = True
    cboModelName.Enabled = True
    result = YdxClose(id)
    If result <> 0 Then
        Call ResultShow("YdxClose", result)
    Else
        Call ResultShow("クローズ", result)
    End If
End Sub

フォームアンロード¶

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    result = YdxClose(id)
    If result <> 0 And result <> YDX_RESULT_NOT_OPEN Then
        Call ResultShow("YdxClose", result)
    End If
End Sub