⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 FRM
📖 第 1 页 / 共 2 页
字号:
    m_bIDI0Flag = 0

    If (Not (m_bDI0Flag Or m_bDI1Flag Or m_bIDI0Flag Or m_bIDI1Flag)) Then
        KillThread
        If (Not m_StartFlag) Then
            btnSelDev.Enabled = 1
        End If
    End If
    usStartFlag = 0
    While (Not flag)
        btnDisable1.Enabled = 0
        btnEnable1.Enabled = 1

        EventSetting.EventType = ADS_EVT_INTERRUPT_IDI0
        EventSetting.Enabled = 0
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)

        If (m_ErrCde <> 0) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
            Exit Sub
        End If
        flag = 1
    Wend
End Sub

Private Sub btnDisable2_Click()
    Dim EventSetting As PT_EnableEvent
    Dim flag As Boolean
    
    flag = 0
    m_bIDI1Flag = 0

    If (Not (m_bDI0Flag Or m_bDI1Flag Or m_bIDI0Flag Or m_bIDI1Flag)) Then
        KillThread
        If (Not m_StartFlag) Then
            btnSelDev.Enabled = 1
        End If
    End If
    usStartFlag = 0
    While (Not flag)
        btnDisable2.Enabled = 0
        btnEnable2.Enabled = 1

        EventSetting.EventType = ADS_EVT_INTERRUPT_IDI1
        EventSetting.Enabled = 0
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)

        If (m_ErrCde <> 0) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
            Exit Sub
        End If
        flag = 1
    Wend
End Sub

Private Sub btnDisable3_Click()
    Dim EventSetting As PT_EnableEvent
    Dim flag As Boolean
    
    flag = 0
    m_bDI0Flag = 0

    If (Not (m_bDI0Flag Or m_bDI1Flag Or m_bIDI0Flag Or m_bIDI1Flag)) Then
        KillThread
        If (Not m_StartFlag) Then
            btnSelDev.Enabled = 1
        End If
    End If
    usStartFlag = 0
    While (Not flag)
        btnDisable3.Enabled = 0
        btnEnable3.Enabled = 1

        EventSetting.EventType = ADS_EVT_INTERRUPT_DI0
        EventSetting.Enabled = 0
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)

        If (m_ErrCde <> 0) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
            Exit Sub
        End If
        flag = 1
    Wend
End Sub

Private Sub btnDisable4_Click()
    Dim EventSetting As PT_EnableEvent
    Dim flag As Boolean
    
    flag = 0
    m_bDI1Flag = 0

    If (Not (m_bDI0Flag Or m_bDI1Flag Or m_bIDI0Flag Or m_bIDI1Flag)) Then
        KillThread
        If (Not m_StartFlag) Then
            btnSelDev.Enabled = 1
        End If
    End If
    usStartFlag = 0
    While (Not flag)
        btnDisable4.Enabled = 0
        btnEnable4.Enabled = 1

        EventSetting.EventType = ADS_EVT_INTERRUPT_DI1
        EventSetting.Enabled = 0
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)

        If (m_ErrCde <> 0) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
            Exit Sub
        End If
        flag = 1
    Wend
End Sub

Private Sub btnEnable1_Click()
    Dim EventSetting As PT_EnableEvent

    m_bIDI0Flag = 1
    usStartFlag = 1
    EventSetting.Enabled = 1
    EventSetting.Count = editCount_IDI0.Text
    EventSetting.EventType = ADS_EVT_INTERRUPT_IDI0
    
    m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)
    If (m_ErrCde <> 0) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        Exit Sub
    End If

    btnDisable1.Enabled = True
    btnEnable1.Enabled = False
    btnSelDev.Enabled = False

    If (m_bFlag = 0) Then
        m_bContinue = 1

        'Create Interrupt Event handler thread and suspend it
        ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, ThreadID)
        If (ThreadHandle = 0) Then
            Response = MsgBox("Create Thread Failed!", vbOKOnly, "Error!!")
             Response = DRV_DeviceClose(DeviceHandle)
            Exit Sub
        End If
    
      'Set thread priority
       ' Using THREAD_PRIORITY_TIME_CRITICAL for interrupt event handling routine,
       ' you can get about 20 KHz response ratio by using PENTIUM 200 MMX PC.
        Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL)
    
       'Awake thread
       Response = ResumeThread(ThreadHandle)
    End If
End Sub

Private Sub btnEnable2_Click()
    Dim EventSetting As PT_EnableEvent

    m_bIDI1Flag = 1
    usStartFlag = 1
    EventSetting.Enabled = 1
    EventSetting.Count = editCount_IDI1.Text
    EventSetting.EventType = ADS_EVT_INTERRUPT_IDI1
    
    m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)
    If (m_ErrCde <> 0) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        Exit Sub
    End If

    btnDisable2.Enabled = 1
    btnEnable2.Enabled = 0
    btnSelDev.Enabled = 0

    If (m_bFlag = 0) Then
        m_bContinue = 1

        'Create Interrupt Event handler thread and suspend it
        ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, ThreadID)
        If (ThreadHandle = 0) Then
            Response = MsgBox("Create Thread Failed!", vbOKOnly, "Error!!")
             Response = DRV_DeviceClose(DeviceHandle)
            Exit Sub
        End If
    
      'Set thread priority
       ' Using THREAD_PRIORITY_TIME_CRITICAL for interrupt event handling routine,
       ' you can get about 20 KHz response ratio by using PENTIUM 200 MMX PC.
        Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL)
    
       'Awake thread
       Response = ResumeThread(ThreadHandle)
    End If
End Sub

Private Sub btnEnable3_Click()
    Dim EventSetting As PT_EnableEvent

    m_bDI0Flag = 1
    usStartFlag = 1
    EventSetting.Enabled = 1
    EventSetting.Count = editCount_DI0.Text
    EventSetting.EventType = ADS_EVT_INTERRUPT_DI0
    
    m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)
    If (m_ErrCde <> 0) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        Exit Sub
    End If

    btnDisable3.Enabled = 1
    btnEnable3.Enabled = 0
    btnSelDev.Enabled = 0

    If (m_bFlag = 0) Then
        m_bContinue = 1

        'Create Interrupt Event handler thread and suspend it
        ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, ThreadID)
        If (ThreadHandle = 0) Then
            Response = MsgBox("Create Thread Failed!", vbOKOnly, "Error!!")
             Response = DRV_DeviceClose(DeviceHandle)
            Exit Sub
        End If
    
      'Set thread priority
       ' Using THREAD_PRIORITY_TIME_CRITICAL for interrupt event handling routine,
       ' you can get about 20 KHz response ratio by using PENTIUM 200 MMX PC.
        Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL)
    
       'Awake thread
       Response = ResumeThread(ThreadHandle)
    End If
End Sub

Private Sub btnEnable4_Click()
    Dim EventSetting As PT_EnableEvent

    m_bDI1Flag = 1
    usStartFlag = 1
    EventSetting.Enabled = 1
    EventSetting.Count = editCount_DI1.Text
    EventSetting.EventType = ADS_EVT_INTERRUPT_DI1
    
    m_ErrCde = DRV_EnableEvent(m_DriverHandle, EventSetting)
    If (m_ErrCde <> 0) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        Exit Sub
    End If

    btnDisable4.Enabled = 1
    btnEnable4.Enabled = 0
    btnSelDev.Enabled = 0

    If (m_bFlag = 0) Then
        m_bContinue = 1

        'Create Interrupt Event handler thread and suspend it
        ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, ThreadID)
        If (ThreadHandle = 0) Then
            Response = MsgBox("Create Thread Failed!", vbOKOnly, "Error!!")
             Response = DRV_DeviceClose(DeviceHandle)
            Exit Sub
        End If
    
      'Set thread priority
       ' Using THREAD_PRIORITY_TIME_CRITICAL for interrupt event handling routine,
       ' you can get about 20 KHz response ratio by using PENTIUM 200 MMX PC.
        Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL)
    
       'Awake thread
       Response = ResumeThread(ThreadHandle)
    End If
End Sub

Private Sub btnSelDev_Click()
    Dim DeviceName As String * 50
    Dim dwData As Long

    If (m_DriverHandle <> 0) Then
        DRV_DeviceClose (m_DriverHandle)
    End If
    DRV_SelectDevice Me.hWnd, 0, m_ulDevNum, DeviceName
    editDevName.Text = DeviceName
    m_ErrCde = DRV_DeviceOpen(m_ulDevNum, m_DriverHandle)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_BoardID, dwData, Len(dwData))
    If (m_ErrCde <> SUCCESS) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Device GetProperty"
    End If
    If (dwData = BD_PCI1736UP) Then
        btnEnable3.Enabled = False
        btnEnable4.Enabled = False
    Else
        btnEnable3.Enabled = True
        btnEnable4.Enabled = True
    End If
End Sub

Private Sub btnStart_Click()
    m_StartFlag = 1
    Timer1.Enabled = 1
    Timer1.Interval = editScanTime.Text
    btnStart.Enabled = 0
    btnStop.Enabled = 1
    btnSelDev.Enabled = 0
End Sub

Private Sub btnStop_Click()
    Timer1.Enabled = 0
    m_StartFlag = 0
    btnStart.Enabled = 1
    btnStop.Enabled = 0
    If (Not (m_bDI0Flag Or m_bDI1Flag Or m_bIDI1Flag Or m_bIDI0Flag Or m_StartFlag)) Then
        btnSelDev.Enabled = 1
    End If
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim ratio As Single
    Dim szBuf_IDI(0 To 3) As String * 20
    Dim DeviceName As String * 50
    Dim dwData As Long

    editScanTime.Text = "1000"
    editChan.Text = "0"
    editCount_DI1.Text = "1"
    editCount_DI0.Text = "1"
    editCount_IDI0.Text = "1"
    editCount_IDI1.Text = "1"
    m_DriverHandle = 0     'driver handle
    m_bContinue = 0
    m_bHiPriority = 0
    m_bFlag = 0
    m_bDI0Flag = 0
    m_bDI1Flag = 0
    m_bIDI0Flag = 0
    m_bIDI1Flag = 0
    m_StartFlag = 0
    ThreadHandle = 0

    For i = 0 To 3
        ratio = 0#
        szBuf_IDI(i) = Format(ratio, "###0.000")
    Next i

    editIntCount_IDI0.Text = szBuf_IDI(0)
    editIntCount_IDI1.Text = szBuf_IDI(1)
    editIntCount_DI0.Text = szBuf_IDI(2)
    editIntCount_DI1.Text = szBuf_IDI(3)

    m_ulDevNum = 0
    DRV_SelectDevice Me.hWnd, 0, m_ulDevNum, DeviceName
    editDevName.Text = DeviceName
    scrollChanSpin.value = 0
    m_ErrCde = DRV_DeviceOpen(m_ulDevNum, m_DriverHandle)
    If (m_ErrCde <> SUCCESS) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Device Open"
    End If
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_BoardID, dwData, Len(dwData))
    If (m_ErrCde <> SUCCESS) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Device GetProperty"
    End If
    If (dwData = BD_PCI1736UP) Then
        btnEnable3.Enabled = False
        btnEnable4.Enabled = False
    Else
        btnEnable3.Enabled = True
        btnEnable4.Enabled = True
    End If
End Sub

Private Sub scrollChanSpin_Change()
    editChan.Text = scrollChanSpin.value
End Sub

Private Sub Timer1_Timer()
    Dim gwValue As Integer     'input value
    Dim szBuf As String * 10

    m_ptDioReadPortByte.Port = editChan.Text
    m_ptDioReadPortByte.value = DRV_GetAddress(gwValue)

    m_ErrCde = DRV_DioReadPortByte(m_DriverHandle, m_ptDioReadPortByte)
    If (m_ErrCde <> 0) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        Timer1.Enabled = 0
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
    Else
        szBuf = Format(Hex(gwValue), "0#")
        editScanData.Text = szBuf
    End If
End Sub

Private Sub KillThread()
    Dim lExitCode As Long
    Dim lRet As Long
    
    m_bContinue = 0
    m_bFlag = 0

    lRet = GetExitCodeThread(ThreadHandle, lExitCode)
    If (lExitCode = STILL_ACTIVE) Then
        lRet = TerminateThread(ThreadHandle, lExitCode)
    End If
    
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -