thread.bas

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

Attribute VB_Name = "Thread"
Option Explicit

' Windows (Constant, Data structure, API) declaration
Public Const CREATE_SUSPENDED = &H4
Public Const THREAD_PRIORITY_NORMAL = &H0
Public Const THREAD_PRIORITY_TIME_CRITICAL = &H15

Global bTimeCritical As Boolean
Global ThreadHandle As Long
Global gbThreadTerminated As Boolean
Global gbStopThread As Boolean

Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Boolean
End Type

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function TerminateThread& Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long)
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Sub EventThread()
'NOTES:
'1. Do not try to set breakpoint in EvenThread(), this will crash the IDE.
'2. Use "Debug.Print" or something else to trace the thread
'3. Use Visual Bacsic 5.0 to compile this sample
'4. Because multi-thread programming was not be well-supported in Visual Basic,
'   debug this sample may often crash the IDE. So you'd better compile this sample
'   to a executable file and run it if you want to see the result.

    Dim lngStartTime As Long
    Dim lngCurrentTime As Long
    Dim lngEventType As Long
    Dim lngEventCount As Long
    Dim lngTotalTime As Long
    Dim Response As Long
    
    ptFDITransfer.EventType = ADS_EVT_INTERRUPT
    ptFDITransfer.RetData = DRV_GetAddress(gReturnData)
    
    ptCheckEvent.EventType = DRV_GetAddress(lngEventType)
    ptCheckEvent.Milliseconds = 1000
        
    lngStartTime = GetTickCount()

    While gbStopThread = False
        gReturnData = 0
        'Check interrupt event
        If (DRV_CheckEvent(DeviceHandle, ptCheckEvent) = SUCCESS) Then
              Debug.Print "ChenkEvent OK!"
            
            If (lngEventType = ADS_EVT_INTERRUPT) Then
                'Read port data when interrupt happened
                lngEventCount = lngEventCount + 1
                Response = DRV_FDITransfer(DeviceHandle, ptFDITransfer)
            
            
            'Display port data
            If (Not Response) Then
                'mainfrm.txtIntData.Text = "0000"
            'Else
                mainfrm.txtIntData.Text = CStr(gReturnData And &H7FFF)
                mainfrm.IntChlText.Text = CStr(gReturnData / 2 ^ 16 And &HFFFF)
            End If
            End If
            
        Else
            Debug.Print "CheckEvent Failed!"
        End If
        
        lngCurrentTime = GetTickCount()
        lngTotalTime = lngCurrentTime - lngStartTime
        
        'Caculate Interrupt Event Count
        If (lngTotalTime > 1000) Then
            gEventCount = CSng((CLng(lngEventCount) / CSng(lngTotalTime) * 1000#))
            lngStartTime = GetTickCount()
            mainfrm.txtEventCount.Text = gEventCount
            lngEventCount = 0
        End If
        
    Wend
    
    mainfrm.txtIntData.Text = ""
    mainfrm.txtEventCount.Text = ""
    mainfrm.IntChlText.Text = ""
    gbThreadTerminated = True
    
End Sub