frmmain.frm

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

   If chkCounter.value = Checked Then
      fCounter.Show vbModal
      If fCounter.bCancel Then
         chkCounter.value = Unchecked
         bCounter = False
      Else
         chkCounter.value = Checked
         
         bCounter = True
         Direction = fCounter.Direction
         TrigEdge = fCounter.TrigEdge
         MatchEnableMask = fCounter.MatchEnableMask
         OverflowEnableMask = fCounter.OverflowEnableMask
         CounterEnableMask = fCounter.EnableMask
         For i = 0 To 7
            PresetValue(i) = Val(fCounter.txtPresetValue(i).Text)
            MatchValue(i) = Val(fCounter.txtMatchValue(i).Text)
         Next i
      End If
   Else
      chkCounter.value = Unchecked
      bCounter = True
      Direction = fCounter.Direction
      TrigEdge = fCounter.TrigEdge
      MatchEnableMask = 0
      OverflowEnableMask = 0
      CounterEnableMask = 0
      For i = 0 To 7
         PresetValue(i) = 0
         MatchValue(i) = 0
      Next i
   End If
End Sub

Private Sub chkFilter_Click()
   Dim i As Integer

   If chkFilter.value = Checked Then
      fFilter.Show vbModal
      If fFilter.bCancel Then
         chkFilter.value = Unchecked
         bFilter = False
      Else
         chkFilter.value = Checked
         bFilter = True
         FilterEnableMask = fFilter.EnableMask
         For i = 0 To 7
            HiValue(i) = Val(fFilter.txtHiValue(i))
            LoValue(i) = Val(fFilter.txtLoValue(i))
         Next i
      End If
   Else
      chkFilter.value = Unchecked
      bFilter = True
      FilterEnableMask = 0
      For i = 0 To 7
         HiValue(i) = 0
         LoValue(i) = 0
      Next i
   End If
End Sub

Private Sub chkPattern_Click()
   If chkPattern.value = Checked Then
      fPattern.Show vbModal
      If fPattern.bCancel Then
         chkPattern.value = Unchecked
         bPattern = False
      Else
         chkPattern.value = Checked
         bPattern = True
         PatternValue = fPattern.PatternValue
         PatternEnableMask = fPattern.EnableMask
      End If
   Else
      chkPattern.value = Unchecked
      bPattern = True
      PatternValue = 0
      PatternEnableMask = 0
   End If
End Sub

Private Sub chkStatus_Click()
   If chkStatus.value = Checked Then
      fStatus.Show vbModal
      If fStatus.bCancel Then
         chkStatus.value = Unchecked
         bStatus = False
      Else
         chkStatus.value = Checked
         bStatus = True
         RisingEdge = fStatus.RisingEdge
         FallingEdge = fStatus.FallingEdge
         StatusEnableMask = fStatus.EnableMask
      End If
   Else
      chkStatus.value = Unchecked
      bStatus = True
      RisingEdge = 0
      FallingEdge = 0
      StatusEnableMask = 0
   End If
End Sub


Private Sub cmdExit_Click()
   End
End Sub

Private Sub cmdStart_Click()
   
   Dim i As Integer

   ErrorNum = DRV_DeviceOpen(DeviceNum, DeviceHandle)
   If CheckError(ErrorNum) <> 0 Then
      Exit Sub
   End If
   ' Set Pattern Match event
   If bPattern Then
      ptDIPattern.EventType = ADS_EVT_PATTERNMATCH
      ptDIPattern.EventEnabled = True
      ptDIPattern.Count = 1
      ptDIPattern.EnableMask = PatternEnableMask
      ptDIPattern.PatternValue = PatternValue
      ErrorNum = DRV_EnableEventEx(DeviceHandle, ptDIPattern)
      If CheckError(ErrorNum) <> 0 Then
         ErrorNum = DRV_DeviceClose(DeviceHandle)
         Exit Sub
      End If
   End If
   ' Set Status change event
   If bStatus Then
      ptDIStatus.EventType = ADS_EVT_STATUSCHANGE
      ptDIStatus.EventEnabled = True
      ptDIStatus.Count = 1
      ptDIStatus.EnableMask = StatusEnableMask
      ptDIStatus.RisingEdge = RisingEdge
      ptDIStatus.FallingEdge = FallingEdge
      ErrorNum = DRV_EnableEventEx(DeviceHandle, ptDIStatus)
      If CheckError(ErrorNum) <> 0 Then
         ErrorNum = DRV_DeviceClose(DeviceHandle)
         Exit Sub
      End If
   End If
   ' Set Filter event
   If bFilter Then
      ptFilter.EventType = ADS_EVT_FILTER
      ptFilter.EventEnabled = True
      ptFilter.Count = 1
      ptFilter.EnableMask = FilterEnableMask
      ptFilter.HiValue = DRV_GetAddress(HiValue(0))
      ptFilter.LowValue = DRV_GetAddress(LoValue(0))
      ErrorNum = DRV_EnableEventEx(DeviceHandle, ptFilter)
      If CheckError(ErrorNum) <> 0 Then
         ErrorNum = DRV_DeviceClose(DeviceHandle)
         Exit Sub
      End If
   End If
   ' Set Counter event
   If bCounter Then
      ptDICounter.EventType = ADS_EVT_COUNTER
      ptDICounter.EventEnabled = 1
      ptDICounter.Count = 1
      ptDICounter.Direction = Direction
      ptDICounter.EnableMask = CounterEnableMask
      ptDICounter.MatchEnableMask = MatchEnableMask
      ptDICounter.OverflowEnableMask = OverflowEnableMask
      ptDICounter.TrigEdge = TrigEdge
      ptDICounter.PresetValue = DRV_GetAddress(PresetValue(0))
      ptDICounter.MatchValue = DRV_GetAddress(MatchValue(0))
      ErrorNum = DRV_EnableEventEx(DeviceHandle, ptDICounter)
      If CheckError(ErrorNum) <> 0 Then
         ErrorNum = DRV_DeviceClose(DeviceHandle)
         Exit Sub
      End If
   End If
   
   ' commented by yingsong.huang at 08/28/02
   ' reason: the mutiple thread is unsafe in vb
   
   ' Create event watch thread
   'If bPattern Or bStatus Or bCounter Then
   '   EventThreadHandle = CreateThread(0, 0, AddressOf EventHandlingThread, _
                           vbNullString, 0, EventThreadId)
      'bEventThreadRunning = True
      'If EventThreadHandle = 0 Then
      '   MsgBox "Open event or create waiting thread error !", vbOK, "Driver Message"
      '   ptDIPattern.EventType = 0
      '   ptDIPattern.EventEnabled = False
      '   ErrorNum = DRV_EnableEventEx(DeviceHandle, ptDIPattern)
      '   ErrorNum = DRV_DeviceClose(DeviceHandle)
      '   Exit Sub
      'End If
    'End If
    
    'add by yingsong.huang at 08/28/02 use timer to track event
   
   cmdStart.Enabled = False
   cmdStop.Enabled = True
   frmChannel.Enabled = False
   EventTimer.Enabled = True
   
   'commented by yingsong.huang
   'bRun = True
End Sub

Private Sub cmdStartScan_Click()
   ErrorNum = DRV_DeviceOpen(DeviceNum, DeviceHandle)
   If CheckError(ErrorNum) <> 0 Then
      Exit Sub
   End If
   
   cmdStartScan.Enabled = False
   cmdStopScan.Enabled = True
   cmdStart.Enabled = False
   ScanTimer.Enabled = True
End Sub

Private Sub cmdStop_Click()
   'commented by yingsong.huang 08/28/02
   'reason: we will not need use thread any more
   'bEventThreadRunning = False
   'Sleep (10)
   
   'flag = True
   'If bPattern Or bStatus Or bCounter Then
   '   While flag = True
   '       If bEventThreadTerminate Then
   '          flag = False
   '       End If
   '   Wend
   'End If
   EventTimer.Enabled = False
   ptFilter.EventType = 0
   ptFilter.EventEnabled = 0
   ErrorNum = DRV_EnableEventEx(DeviceHandle, ptFilter)
   CheckError (ErrorNum)
   
   DRV_DeviceClose (DeviceHandle)

   cmdStart.Enabled = True
   cmdStop.Enabled = False
   frmChannel.Enabled = True
   'bRun = False
   
   
End Sub

Private Sub cmdStopScan_Click()
   DRV_DeviceClose (DeviceHandle)
   
   ScanTimer.Enabled = False
   cmdStartScan.Enabled = True
   cmdStopScan.Enabled = False
   cmdStart.Enabled = True
End Sub

Private Sub EventTimer_Timer()
    
    Dim EventType As Integer
    Dim ReturnValue As Integer
    Dim ptCheckEvent As PT_CheckEvent
    Dim ptFDITransfer As PT_FDITransfer

   
    ptCheckEvent.EventType = DRV_GetAddress(EventType)
    ptCheckEvent.Milliseconds = 1000
      
      ErrorNum = DRV_CheckEvent(frmMain.DeviceHandle, ptCheckEvent)
      If frmMain.CheckError(ErrorNum) <> 0 Then
         ErrorNum = DRV_DeviceClose(frmMain.DeviceHandle)
         Exit Sub
      End If
      
      ' Check event
      Select Case EventType
      Case ADS_EVT_PATTERNMATCH     ' Pattern Match Event
            ptFDITransfer.EventType = ADS_EVT_PATTERNMATCH
            ptFDITransfer.RetData = DRV_GetAddress(ReturnValue)
            ErrorNum = DRV_FDITransfer(DeviceHandle, ptFDITransfer)
            If CheckError(ErrorNum) Then
               ErrorNum = DRV_DeviceClose(DeviceHandle)
               Exit Sub
            End If
            PatternEventCount = PatternEventCount + 1
            labPatternMatchCount.Caption = Str(PatternEventCount)
         

      Case ADS_EVT_COUNTERMATCH
         
            ptFDITransfer.EventType = ADS_EVT_COUNTERMATCH
            ptFDITransfer.RetData = DRV_GetAddress(ReturnValue)
            ErrorNum = DRV_FDITransfer(DeviceHandle, ptFDITransfer)
            If CheckError(ErrorNum) Then
               ErrorNum = DRV_DeviceClose(DeviceHandle)
               Exit Sub
            End If
            CountMatchEventCount = CountMatchEventCount + 1
            labMatchChannel.Caption = Str(ReturnValue)
            labMatchCount.Caption = Str(CountMatchEventCount)
         
      Case ADS_EVT_COUNTEROVERFLOW
         
            ptFDITransfer.EventType = ADS_EVT_COUNTEROVERFLOW
            ptFDITransfer.RetData = DRV_GetAddress(ReturnValue)
            ErrorNum = DRV_FDITransfer(DeviceHandle, ptFDITransfer)
            If CheckError(ErrorNum) Then
               ErrorNum = DRV_DeviceClose(DeviceHandle)
               Exit Sub
            End If
            CountOverflowEventCount = CountOverflowEventCount + 1
            labOverflowChannel.Caption = Str(ReturnValue)
            labOverflowCount.Caption = Str(CountOverflowEventCount)
         

      Case ADS_EVT_STATUSCHANGE
        
            ptFDITransfer.EventType = ADS_EVT_STATUSCHANGE
            ptFDITransfer.RetData = DRV_GetAddress(ReturnValue)
            ErrorNum = DRV_FDITransfer(DeviceHandle, ptFDITransfer)
            If CheckError(ErrorNum) Then
               ErrorNum = DRV_DeviceClose(DeviceHandle)
               Exit Sub
            End If
            
            If (ReturnValue And &HFF) Then
               FallingEventCount = FallingEventCount + 1
               labStatus.Caption = "Falling"
               labChannelNo.Caption = Str(ReturnValue And &HFF)
               labStatusCount.Caption = Str(FallingEventCount)
            ElseIf (ReturnValue And &HFF00) Then
               RisingEventCount = RisingEventCount + 1
               labStatus.Caption = "Rising"
               labChannelNo.Caption = Str((ReturnValue And &HFF00) / &H100)
               labStatusCount.Caption = Str(RisingEventCount)
            End If
      
      End Select
    
End Sub

Private Sub Form_Load()
   RisingEventCount = 0
   FallingEventCount = 0
   PatternEventCount = 0
   CountMatchEventCount = 0
   CountOverflowEventCount = 0
   bRun = False
   bEventThreadRunning = False
   Call btnSelectDevice_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
   If bRun = True Then
      Call cmdStop_Click
   End If
   Unload fCounter
   Unload fStatus
   Unload fPattern
   Unload fFilter
End Sub

Private Sub ScanTimer_Timer()
   Dim InputData As Integer

   If bMutex = False Then
      bMutex = True
      ptDioReadPortByte.Port = Val(txtChannelNo.Text)
      ptDioReadPortByte.value = DRV_GetAddress(InputData)
      ErrorNum = DRV_DioReadPortByte(DeviceHandle, ptDioReadPortByte)
      If CheckError(ErrorNum) <> 0 Then
         ErrorNum = DRV_DeviceClose(DeviceHandle)
         Exit Sub
      End If
      labValue.Caption = Str(InputData)
      bMutex = False
   End If
End Sub

Private Sub txtScanTime_Change()
   ScanTimer.Interval = Val(txtScanTime.Text)
End Sub

Public Function CheckError(ByVal lErrCde As Long) As Boolean
   Dim szErrMsg As String * 80

   If (lErrCde <> 0) Then
      DRV_GetErrorMessage lErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
      CheckError = True
   Else
      CheckError = False
   End If
End Function