cntcompare.frm

16 relay output channels and 16 isolated digital input channels LED indicators to show activated

         Begin VB.TextBox txtSingleData 
            Height          =   375
            Left            =   120
            TabIndex        =   41
            Text            =   "500"
            Top             =   360
            Width           =   1455
         End
      End
      Begin VB.Label Label12 
         Caption         =   "Compare Data:"
         Height          =   255
         Left            =   240
         TabIndex        =   44
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.Label Label3 
      Caption         =   "Counter Count:"
      Height          =   255
      Left            =   240
      TabIndex        =   47
      Top             =   5760
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmbCounter_Change()
    Dim ulSize As Long
    Dim Dimension As Integer
    Dim pBuffer() As Long
    Dim usCounter As Integer
    
    usCounter = cmbCounter.ListIndex
    
    chkDOIndicate.value = 0
    chkBigComp.value = 0
    chkSmallComp.value = 0
    optLevel.value = False
    optClock.value = False
    
    ' Get Property
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrIndicatorControl, Null, ulSize)
    Dimension = ulSize / Len(ulSize)
    ReDim pBuffer(Dimension)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrIndicatorControl, pBuffer(0), ulSize)
    If (pBuffer(usCounter) And OVERCOMPLEVEL) Then
        chkDOIndicate.value = 1
        chkBigComp.value = 1
        optLevel.value = True
    End If
    If (pBuffer(usCounter) And OVERCOMPPULSE) Then
        chkDOIndicate.value = 1
        chkBigComp.value = 1
        optClock.value = True
    End If
    If (pBuffer(usCounter) And UNDERCOMPLEVEL) Then
        chkDOIndicate.value = 1
        chkSmallComp.value = 1
        optLevel.value = True
    End If
    If (pBuffer(usCounter) And UNDERCOMPPULSE) Then
        chkDOIndicate.value = 1
        chkSmallComp.value = 1
        optClock.value = True
    End If
End Sub

Private Sub cmdClose_Click()
    m_bContinue = False
    
    If (m_DriverHandle <> 0) Then
        DRV_DeviceClose (m_DriverHandle)
    End If
    
    Unload Me
    ExitProcess 0
End Sub

Private Sub cmdReset_Click()
    Dim usCounter As Integer
    
    usCounter = cmbCounter.ListIndex
    m_ErrCde = DRV_CounterReset(m_DriverHandle, usCounter)

End Sub

Private Sub cmdSelDev_Click()
    Dim DeviceName As String * 50
    
    If (m_DriverHandle <> 0) Then
        DRV_DeviceClose (m_DriverHandle)
    End If
        
    DRV_SelectDevice Me.hwnd, 0, m_ulDevNum, DeviceName
    txtDevName.Text = DeviceName
    
    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
End Sub

Private Sub cmdSetComp_Click()
    Dim ulSize As Long
    Dim CompareData() As Long
    Dim Dimension As Integer
    Dim usCounter As Integer
    
    usCounter = cmbCounter.ListIndex

    'Set compare data
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, Null, ulSize)
    Dimension = ulSize / Len(ulSize)
    ReDim CompareData(Dimension)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, CompareData(0), ulSize)
    CompareData(usCounter) = txtSingleData.Text
    m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_CntrCompareData, CompareData(0), ulSize)
    txtCompData.Text = txtSingleData.Text

    ' Set compare type to single compare
    m_CompType = 0
    m_CompIndex = 0
    
End Sub

Private Sub cmdSetTable_Click()
    Dim ulSize As Long
    Dim CompareData() As Long
    Dim Dimension As Integer
    Dim usCounter As Integer
    
    usCounter = cmbCounter.ListIndex

    'Set compare data
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, Null, ulSize)
    Dimension = ulSize / Len(ulSize)
    ReDim CompareData(Dimension)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, CompareData(0), ulSize)
    CompareData(usCounter) = txtD0.Text
    m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_CntrCompareData, CompareData(0), ulSize)
    txtCompData.Text = txtD0.Text

    ' Set compare type to compare table
    m_CompType = 1
    m_CompIndex = 0
End Sub

Private Sub cmdStart_Click()
    Dim ulSize As Long
    Dim CompareData() As Long
    Dim pBuffer() As Long
    Dim Dimension As Integer
    Dim ptEnableEvent As PT_EnableEvent
    Dim ptCounterEventStart As PT_CounterEventStart
    
    m_CurCounter = cmbCounter.ListIndex
    m_OverComp = chkOverComp.value
    m_UnderComp = chkUnderComp.value
    
    'Set compare data
    If (m_CompType) Then
        cmdSetTable_Click
    End If
            
    'Set indicator
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrIndicatorControl, Null, ulSize)
    Dimension = ulSize / Len(ulSize)
    ReDim pBuffer(Dimension)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrIndicatorControl, pBuffer(0), ulSize)
    pBuffer(m_CurCounter) = 0
    If (chkDOIndicate.value = 1) Then
        If (chkBigComp.value = 1) Then
            If (optClock.value = True) Then
                pBuffer(m_CurCounter) = pBuffer(m_CurCounter) Or OVERCOMPPULSE
            End If
            If (optLevel.value = True) Then
                pBuffer(m_CurCounter) = pBuffer(m_CurCounter) Or OVERCOMPLEVEL
            End If
        End If
        If (chkSmallComp.value = 1) Then
            If (optClock.value = True) Then
                pBuffer(m_CurCounter) = pBuffer(m_CurCounter) Or UNDERCOMPPULSE
            End If
            If (optLevel.value = True) Then
                pBuffer(m_CurCounter) = pBuffer(m_CurCounter) Or UNDERCOMPLEVEL
            End If
        End If
    End If
    m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_CntrIndicatorControl, pBuffer(0), ulSize)
    
    'Initialize Compare data array
    m_CompData(0) = txtD0.Text
    m_CompData(1) = txtD1.Text
    m_CompData(2) = txtD2.Text
    m_CompData(3) = txtD3.Text
    m_CompData(4) = txtD4.Text
    m_CompData(5) = txtD5.Text
    m_CompData(6) = txtD6.Text
    m_CompData(7) = txtD7.Text
    
    'Enable Event
    ptEnableEvent.Count = 1
    ptEnableEvent.Enabled = 1
    If (m_OverComp = 1) Then
        ptEnableEvent.EventType = ADS_EVT_OVERCOMPARE_CNT0 + m_CurCounter
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEnableEvent)
        If (m_ErrCde <> SUCCESS) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        End If
    End If
    If (m_UnderComp = 1) Then
        ptEnableEvent.EventType = ADS_EVT_UNDERCOMPARE_CNT0 + m_CurCounter
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEnableEvent)
        If (m_ErrCde <> SUCCESS) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        End If
    End If
    
    'start counter
    ptCounterEventStart.counter = m_CurCounter
    m_ErrCde = DRV_CounterEventStart(m_DriverHandle, ptCounterEventStart)
    
    cmdSelDev.Enabled = False
    cmdStart.Enabled = False
    cmdStop.Enabled = True
    cmdClose.Enabled = False
    
    'start thread
    m_bContinue = True
    HandleofForm1 = Me.hwnd
    
    ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, THREAD_SUSPENDED, ThreadID)
    If (ThreadHandle = 0) Then
        MsgBox "Create Thread Failed!", vbOKOnly, "Error!"
        DRV_DeviceClose (m_DriverHandle)
    End If

    Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL)
    Response = ResumeThread(ThreadHandle)

End Sub

Private Sub cmdStop_Click()
    Dim ptEnableEvent As PT_EnableEvent
    
    m_bContinue = False
    
    ' Disable event
    ptEnableEvent.Count = 1
    ptEnableEvent.Enabled = 0
    If (m_OverComp = 1) Then
        ptEnableEvent.EventType = ADS_EVT_OVERCOMPARE_CNT0 + m_CurCounter
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEnableEvent)
        If (m_ErrCde <> SUCCESS) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        End If
    End If
    If (m_UnderComp = 1) Then
        ptEnableEvent.EventType = ADS_EVT_UNDERCOMPARE_CNT0 + m_CurCounter
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEnableEvent)
        If (m_ErrCde <> SUCCESS) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        End If
    End If
    
    'Reset counter
    m_ErrCde = DRV_CounterReset(m_DriverHandle, m_CurCounter)
    
    
    cmdSelDev.Enabled = True
    cmdStart.Enabled = True
    cmdStop.Enabled = False
    cmdClose.Enabled = True
    
End Sub

Private Sub Form_Load()
    Dim DeviceName As String * 50
    Dim ulSize As Long
    Dim Dimension As Integer
    Dim pBuffer() As Long
    Dim tmp As Long
    
    m_ulDevNum = 0
    DRV_SelectDevice Me.hwnd, 0, m_ulDevNum, DeviceName
    txtDevName.Text = DeviceName
    
    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_CompType = 1
    m_CompIndex = 0

    cmbCounter.AddItem "Counter 0"
    cmbCounter.AddItem "Counter 1"
    cmbCounter.AddItem "Counter 2"
    cmbCounter.AddItem "Counter 3"

    cmbCounter.ListIndex = 0

    ' Get Property
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrIndicatorControl, Null, ulSize)
    Dimension = ulSize / Len(ulSize)
    ReDim pBuffer(Dimension)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrIndicatorControl, pBuffer(0), ulSize)
    If (pBuffer(0) And OVERCOMPLEVEL) Then
        chkDOIndicate.value = 1
        chkBigComp.value = 1
        optLevel.value = True
    End If
    If (pBuffer(0) And OVERCOMPPULSE) Then
        chkDOIndicate.value = 1
        chkBigComp.value = 1
        optClock.value = True
    End If
    If (pBuffer(0) And UNDERCOMPLEVEL) Then
        chkDOIndicate.value = 1
        chkSmallComp.value = 1
        optLevel.value = True
    End If
    If (pBuffer(0) And UNDERCOMPPULSE) Then
        chkDOIndicate.value = 1
        chkSmallComp.value = 1
        optClock.value = True
    End If

    Hook Me.hwnd
    
End Sub

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

    If (ThreadHandle <> 0) Then
        lRet = GetExitCodeThread(ThreadHandle, lExitCode)
        If (lExitCode = STILL_ACTIVE) Then
            lRet = TerminateThread(ThreadHandle, lExitCode)
            Sleep (1000)
        End If
    End If
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim ptEnableEvent As PT_EnableEvent
    
    m_bContinue = False
    
    If (m_bContinue = True) Then
        ' Disable event
        ptEnableEvent.Count = 1
        ptEnableEvent.Enabled = 0
        If (m_OverComp = 1) Then
            ptEnableEvent.EventType = ADS_EVT_OVERCOMPARE_CNT0 + m_CurCounter
            m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEnableEvent)
            If (m_ErrCde <> SUCCESS) Then
                DRV_GetErrorMessage m_ErrCde, m_szErrMsg
                MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
            End If
        End If
        If (m_UnderComp = 1) Then
            ptEnableEvent.EventType = ADS_EVT_UNDERCOMPARE_CNT0 + m_CurCounter
            m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEnableEvent)
            If (m_ErrCde <> SUCCESS) Then
                DRV_GetErrorMessage m_ErrCde, m_szErrMsg
                MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
            End If
        End If
        
        'Reset counter
        m_ErrCde = DRV_CounterReset(m_DriverHandle, m_CurCounter)
        
        If (m_DriverHandle <> Null) Then
            DRV_DeviceClose m_DriverHandle
        End If
    End If
    ExitProcess 0
    
End Sub