Visual Basic 6.0¶

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_DI_EXCEED_DATA_NUM, Ydx.YDX_RESULT_DI_EXCEED_BUF_SIZ
            MsgBox resultString, vbInformation, title
        Case Else
            MsgBox resultString, vbCritical, title
    End Select
End Sub

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 "DIO-16/16C-USC"
    cboModelName.AddItem "DIO-16/16D-UBC"
    cboModelName.AddItem "DIO-16/16D-USC"
    cboModelName.ListIndex = 0
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
        Call ResultShow("オープン", result)
    End If
End Sub

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

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

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

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

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

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

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

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

    ' デジタル入力動作を開始
    result = YdxDiStart(id)
    If result <> 0 Then
        Call ResultShow("YdxDiStart", result)
        Exit Sub
    End If

    ' 動作終了待ち
    Dim status, sampleCount, repeatCount As Long
    ' 動作中ステータスがOFFになるまでポーリング
    Do
        ' ステータスの取得
        result = YdxDiGetStatus(id, status, sampleCount, repeatCount)
        If result <> 0 Then
            Call ResultShow("YdxDiGetStatus", result)
            Exit Sub
        End If
        txtStatus.Text = Right("0000000" & Hex(status), 8) & "h"
        txtSampleCount.Text = Format(sampleCount)
        txtRepeatCount.Text = Format(repeatCount)
        DoEvents

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

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

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

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

    ' データの読み出し
    Dim data() As Long
    ReDim data(sampleCount)
    result = YdxDiGetData(id, sampleCount, data(0))
    If result <> 0 Then
        Call ResultShow("YdxDiGetData", result)
        If result <> YDX_RESULT_DI_EXCEED_DATA_NUM And result <> YDX_RESULT_DI_EXCEED_BUF_SIZ Then
            Exit Sub
        End If
    End If

    ' 表示
    Dim txt As String
    txt = ""
    Dim sampleIndex As Long
    For sampleIndex = 0 To sampleCount - 1
        txt = txt & Right("    " & Str(sampleIndex + 1), 5) & " : "

        ' 2進数表記
        Dim dt As Long
        dt = data(sampleIndex)
        Dim bitMask As Long
        bitMask = 32768
        Dim place As Integer
        For place = 0 To 15
            if(dt And bitMask) <> 0 Then
                txt = txt & "1"
            Else
                txt = txt & "0"
            End If
            If place = 3 Or place = 7 Or place = 11 Then
                txt = txt & " "
            End If
            bitMask = bitMask / 2
        Next

        ' 16進数表記
        txt = txt & " (" & Right("   " & Hex(data(sampleIndex)), 4) & "h)" & 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