tmcntset.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Advantech Driver Demo: Timer Counter for PCI-1784"
   ClientHeight    =   4050
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6810
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4050
   ScaleWidth      =   6810
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdClose 
      Caption         =   "Close"
      Height          =   375
      Left            =   4920
      TabIndex        =   12
      Top             =   3360
      Width           =   1215
   End
   Begin VB.Frame Frame4 
      Height          =   1215
      Left            =   120
      TabIndex        =   7
      Top             =   2640
      Width           =   4695
      Begin VB.CommandButton cmdDisable 
         Caption         =   "Disable"
         Height          =   375
         Left            =   3480
         TabIndex        =   11
         Top             =   720
         Width           =   1095
      End
      Begin VB.CommandButton cmdEnable 
         Caption         =   "Enable"
         Height          =   375
         Left            =   3480
         TabIndex        =   10
         Top             =   240
         Width           =   1095
      End
      Begin VB.TextBox txtEventCount 
         BackColor       =   &H80000000&
         Height          =   375
         Left            =   1800
         TabIndex        =   9
         TabStop         =   0   'False
         Top             =   360
         Width           =   1335
      End
      Begin VB.Label Label2 
         Caption         =   "Event Count:"
         Height          =   375
         Left            =   120
         TabIndex        =   8
         Top             =   480
         Width           =   1335
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "Timer Interval Set"
      Height          =   1335
      Left            =   120
      TabIndex        =   3
      Top             =   1200
      Width           =   6375
      Begin VB.OptionButton optUs 
         Caption         =   "us"
         Height          =   315
         Left            =   3480
         TabIndex        =   17
         TabStop         =   0   'False
         Top             =   390
         Value           =   -1  'True
         Width           =   495
      End
      Begin VB.OptionButton optMs 
         Caption         =   "ms"
         Height          =   315
         Left            =   3960
         TabIndex        =   16
         TabStop         =   0   'False
         Top             =   390
         Width           =   495
      End
      Begin VB.OptionButton optS 
         Caption         =   "s"
         Height          =   315
         Left            =   4440
         TabIndex        =   15
         TabStop         =   0   'False
         Top             =   390
         Width           =   495
      End
      Begin VB.TextBox txtTimerInterval 
         Height          =   375
         Left            =   1800
         TabIndex        =   14
         TabStop         =   0   'False
         Text            =   "20"
         Top             =   360
         Width           =   1575
      End
      Begin VB.TextBox txtRealTimerInt 
         BackColor       =   &H80000000&
         Height          =   375
         Left            =   1800
         TabIndex        =   6
         TabStop         =   0   'False
         Top             =   840
         Width           =   1575
      End
      Begin VB.CommandButton btnSetTimer 
         Caption         =   "Set"
         Height          =   375
         Left            =   120
         TabIndex        =   4
         TabStop         =   0   'False
         Top             =   360
         Width           =   1335
      End
      Begin VB.Label Label3 
         Caption         =   "(from 20us to 51s)"
         Height          =   255
         Left            =   4920
         TabIndex        =   18
         Top             =   450
         Width           =   1335
      End
      Begin VB.Label labUnit 
         Caption         =   "us"
         Height          =   255
         Left            =   3480
         TabIndex        =   13
         Top             =   960
         Width           =   375
      End
      Begin VB.Label Label1 
         Caption         =   "Real Timer Interval"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   960
         Width           =   1335
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Device Selection"
      Height          =   975
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6015
      Begin VB.CommandButton cmdSelDev 
         Caption         =   "Select Device"
         Height          =   375
         Left            =   4560
         TabIndex        =   2
         TabStop         =   0   'False
         Top             =   360
         Width           =   1215
      End
      Begin VB.TextBox editDevName 
         Height          =   375
         Left            =   120
         TabIndex        =   1
         TabStop         =   0   'False
         Top             =   360
         Width           =   4335
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub btnSetTimer_Click()
    Dim ulTimerInterval As Long
    Dim ulSize As Long
    Dim usDividor As Integer
    Dim fFreq As Single
    Dim fFreqBase As Single
    Dim pTimerFreq() As Single
    Dim usTmp As Integer
    Dim ptTimerCountSetting As PT_TimerCountSetting
    
    If (m_usUnit = 3) Then
        ulTimerInterval = txtTimerInterval.Text * 1000000
    End If
    If (m_usUnit = 2) Then
        ulTimerInterval = txtTimerInterval.Text * 1000
    End If
    If (m_usUnit = 1) Then
        ulTimerInterval = txtTimerInterval.Text
    End If
    
    fFreq = 1000000 / ulTimerInterval
    
    If (fFreq > 5000) Then
        fFreqBase = 50000
    ElseIf ((fFreq <= 5000) And (fFreq > 500)) Then
        fFreqBase = 5000
    ElseIf ((fFreq <= 500) And (fFreq > 50)) Then
        fFreqBase = 500
    ElseIf ((fFreq <= 50) And (fFreq > 5)) Then
        fFreqBase = 50
    Else
        fFreqBase = 5
    End If
    
    usDividor = ulTimerInterval * fFreqBase / 1000000
    If (usDividor = 0) Then
        usDividor = 1
    End If
        
    'set timer base
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrClockFrequency, Null, ulSize)
    usTmp = ulSize / Len(fFreq)
    ReDim pTimerFreq(usTmp)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrClockFrequency, pTimerFreq(0), ulSize)
    pTimerFreq(4) = fFreq
    m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_CntrClockFrequency, pTimerFreq(0), ulSize)
    If (m_ErrCde <> SUCCESS) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
    End If
    
    'set timer counter
    ptTimerCountSetting.Count = usDividor
    ptTimerCountSetting.counter = 4
    m_ErrCde = DRV_TimerCountSetting(m_DriverHandle, ptTimerCountSetting)
    If (m_ErrCde <> SUCCESS) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        Exit Sub
    End If
    
    'real timer interval
    ulTimerInterval = 1000000 / fFreqBase * usDividor
    If (ulTimerInterval >= 1000000) Then
        ulTimerInterval = ulTimerInterval / 1000000
        labUnit.Caption = "s"
    ElseIf ((ulTimerInterval >= 1000) And (ulTimerInterval < 1000000)) Then
        ulTimerInterval = ulTimerInterval / 1000
        labUnit.Caption = "ms"
    Else
        labUnit.Caption = "us"
    End If
    
    txtRealTimerInt.Text = ulTimerInterval
    
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 cmdDisable_Click()
    Dim ptEventEnable As PT_EnableEvent
    
    'Disable event
    ptEventEnable.Count = 1
    ptEventEnable.Enabled = 0
    ptEventEnable.EventType = ADS_EVT_INTERRUPT_TIMER4
    m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEventEnable)
    If (m_ErrCde <> SUCCESS) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
    End If
    
    m_bContinue = False
    
    Do While (m_bThreadStop = False)
        'MsgBox "loop" Wait for thread to terminate
    Loop
    
    cmdSelDev.Enabled = True
    cmdEnable.Enabled = True
    cmdDisable.Enabled = False
    cmdClose.Enabled = True
End Sub

Private Sub cmdEnable_Click()
    Dim ptEventEnable As PT_EnableEvent
    Dim ThreadID As Long
    
    m_ErrCde = DRV_CounterReset(m_DriverHandle, 0)
    
    'Enable event
    ptEventEnable.Count = 1
    ptEventEnable.Enabled = 1
    ptEventEnable.EventType = ADS_EVT_INTERRUPT_TIMER4
    m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEventEnable)
    If (m_ErrCde <> SUCCESS) Then
        DRV_GetErrorMessage m_ErrCde, m_szErrMsg
        MsgBox m_szErrMsg, vbOKOnly, "Drvier Message"
    End If
    
    cmdSelDev.Enabled = False
    cmdEnable.Enabled = False
    cmdDisable.Enabled = True
    cmdClose.Enabled = False
    
    m_bContinue = True

    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)
    
    m_bThreadStop = False
    
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
    editDevName.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 Form_Load()
    Dim DeviceName As String * 50
    
    m_ulDevNum = 0
    DRV_SelectDevice Me.hWnd, 0, m_ulDevNum, DeviceName
    editDevName.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_usUnit = 1
    m_bThreadStop = True
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim ptEventEnable As PT_EnableEvent
    
    If (m_bContinue = True) Then
        'Disable event
        ptEventEnable.Count = 1
        ptEventEnable.Enabled = 0
        ptEventEnable.EventType = ADS_EVT_INTERRUPT_TIMER4
        m_ErrCde = DRV_EnableEvent(m_DriverHandle, ptEventEnable)
        If (m_ErrCde <> SUCCESS) Then
            DRV_GetErrorMessage m_ErrCde, m_szErrMsg
            MsgBox m_szErrMsg, vbOKOnly, "Driver Message"
        End If
        
        If (m_DriverHandle <> 0) Then
            DRV_DeviceClose (m_DriverHandle)
        End If
    End If

    m_bContinue = False
    Do While (m_bThreadStop = False)
        'MsgBox "loop" Wait for thread to terminate
    Loop

    ExitProcess 0
    
End Sub

Private Sub optMs_Click()
    m_usUnit = 2
End Sub

Private Sub optS_Click()
    m_usUnit = 3
End Sub

Private Sub optUs_Click()
    m_usUnit = 1
End Sub