mainform.frm

来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 596 行 · 第 1/2 页

        End If
        lstItem.SubItems(1) = strTemp
     Next i
    
End Sub
Private Sub SetListFilter()
 
    Dim lstItem As ListItem
      Dim lTemp As Long
  For i = 0 To m_DIChanNum - 1
    If (i Mod 32) = 31 Then
     lTemp = -(2 ^ 31)
     Else
     lTemp = 2 ^ (i Mod 32)
     End If
   Set lstItem = InterruptList.ListItems(i + 1)
        If (DIFilterEnable(i \ 32) And lTemp) Then
           lstItem.SubItems(2) = "Yes"
         Else
             lstItem.SubItems(2) = "No"
        End If
    Next i
    
    
    
End Sub


Private Sub cmdEnableFilter_Click()
 Dim settingFrm As New SettingForm
For i = 0 To 3
   DISetting(i) = DIFilterEnable(i)
  Next i
 settingFrm.txtInfo.Caption = "Enable or disable Filter for every DI channel:"
settingFrm.Show (vbModal)
If settingFrm.Ok = True Then
    For i = 0 To 3
      DIFilterEnable(i) = DISetting(i)
    Next i
    SetListFilter
End If
Unload settingFrm
    ulDataLength = Len(DIFilterEnable(0)) * 4

m_FilterCounter = txtFilterCounter.Text
    m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_DiFilterEnableForAll, DIFilterEnable(0), ulDataLength)
    ulDataLength = Len(m_FilterCounter)
       'Get the DI filter counter: Timer = Counter * 0.0001 * 2( 10M clock)
   m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_DiFilterIntervalCounter, m_FilterCounter, ulDataLength)

End Sub

Private Sub cmdExit_Click()
    If (ThreadHandle <> 0) Then
       GetExitCodeThread ThreadHandle, ExitCode
       
       If (ExitCode = STILL_ACTIVE) Then
          TerminateThread ThreadHandle, ExitCode
       End If
    End If

Unload Me
End Sub


Private Sub cmdFalling_Click()
 Dim settingFrm As New SettingForm
For i = 0 To 3
   DISetting(i) = DIFallingTrigger(i)
  Next i
 settingFrm.txtInfo.Caption = "Enable or disable Falling trigger for every DI channel:"
settingFrm.Show (vbModal)
If settingFrm.Ok = True Then
    For i = 0 To 3
      DIFallingTrigger(i) = DISetting(i)
    Next i
    SetListTrigger
End If

 Unload settingFrm
    ulDataLength = Len(DIFallingTrigger(0)) * 4
      'Get the DI Rising Trigger interrupt
    m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_DiTriggerEnableFallingForAll, DIFallingTrigger(0), ulDataLength)



End Sub

Private Sub cmdRising_Click()
 Dim settingFrm As New SettingForm
For i = 0 To 3
   DISetting(i) = DIRisingTrigger(i)
  Next i
 settingFrm.txtInfo.Caption = "Enable or disable Rising trigger for every DI channel:"
settingFrm.Show (vbModal)
If settingFrm.Ok = True Then
    For i = 0 To 3
      DIRisingTrigger(i) = DISetting(i)
    Next i
    SetListTrigger
End If
    Unload settingFrm
       ulDataLength = Len(DIRisingTrigger(0)) * 4
      'Get the DI Rising Trigger interrupt
  m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_DiTriggerEnableRisingForAll, DIRisingTrigger(0), ulDataLength)
 
End Sub

Private Sub cmdSelect_Click()
    Dim DeviceName As String * 50
    Dim ptGetFeatures As PT_DeviceGetFeatures
    Dim lpDevFeatures As DEVFEATURES
    Dim i As Integer
    Dim strTemp As String
    
    m_bThreadFlag = False
    
    cmbPort.Clear
    InterruptList.ListItems.Clear
    
    If (m_DriverHandle <> 0) Then
        DRV_DeviceClose (m_DriverHandle)
    End If
      'Select the Device
  DRV_SelectDevice Me.hWnd, 0, m_ulDevNum, DeviceName
    txtDeviceName.Caption = DeviceName
      'Open the Device
  m_ErrCde = DRV_DeviceOpen(m_ulDevNum, m_DriverHandle)
    If m_ErrCde <> 0 Then
    MsgBox ("The Device error")
    Exit Sub
    End If
       'Get the feature of the device
 ptGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
    m_ErrCde = DRV_DeviceGetFeatures(m_DriverHandle, ptGetFeatures)
    m_DIChanNum = lpDevFeatures.usMaxDIChl
    ulDataLength = Len(DIRisingTrigger(0)) * 4
      'Get the DI Rising Trigger interrupt
  m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_DiTriggerEnableRisingForAll, DIRisingTrigger(0), ulDataLength)
      'Get the DI Falling Trigger  interrupt
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_DiTriggerEnableFallingForAll, DIFallingTrigger(0), ulDataLength)
    m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_DiFilterEnableForAll, DIFilterEnable(0), ulDataLength)
    ulDataLength = Len(m_FilterCounter)
       'Get the DI filter counter: Timer = Counter * 0.0001 * 2( 10M clock)
   m_ErrCde = DRV_DeviceGetProperty(m_DriverHandle, CFG_DiFilterIntervalCounter, m_FilterCounter, ulDataLength)
    If m_FilterCounter > 0 Then
       txtFilterCounter.Text = Str(m_FilterCounter)
    Else
      txtFilterFreq.Caption = ""
    End If
    
    Dim SubItem As ListItem
    For i = 0 To m_DIChanNum - 1
     Set SubItem = InterruptList.ListItems.Add(, , "Port" & Hex(i \ 8) & "_" & Str(i Mod 8))
    Next i
    For i = 0 To m_DIChanNum \ 8 - 1
     cmbPort.AddItem ("Port" & Hex(i))
    Next i
    cmbPort.ListIndex = 0
    SetListFilter
    SetListTrigger

End Sub



Private Sub cmdStart_Click()
 ScanTimer.Enabled = True
 cmdStart.Enabled = False
 cmdStop.Enabled = True
 
 
End Sub

Private Sub cmdStop_Click()
 ScanTimer.Enabled = False
 cmdStart.Enabled = True
 cmdStop.Enabled = False

End Sub

Private Sub cmdStopAll_Click()

    For i = 0 To m_DIChanNum - 1
    
       If (InterruptList.ListItems(i + 1).Checked) Then
            InterruptList.ListItems(i + 1).Checked = False
        End If
    Next i

    If (ThreadHandle <> 0) Then
       GetExitCodeThread ThreadHandle, ExitCode
       
       If (ExitCode = STILL_ACTIVE) Then
          TerminateThread ThreadHandle, ExitCode
       End If
    End If
    m_bThreadFlag = False
    IntTimer.Enabled = False

End Sub

Private Sub Form_Load()
cmdSelect_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If (m_DriverHandle <> 0) Then
        DRV_DeviceClose (m_DriverHandle)
    End If
  Call TerminateProcess(GetCurrentProcess, ByVal 0&)
End Sub

Private Sub InterruptList_ItemCheck(ByVal Item As MSComctlLib.ListItem)
Dim Response As Long
    Dim EventSetting As PT_EnableEvent

   If Item.Checked Then
      EventSetting.Enabled = 1
Else
      EventSetting.Enabled = 0
End If
    EventSetting.Count = 1
    EventSetting.EventType = ADS_EVT_INTERRUPT_DI0 + Item.Index - 1
    
    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



 If (m_bThreadFlag = False) Then
        '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(m_DriverHandle)
            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_NORMAL)
    
       'Awake thread
       Response = ResumeThread(ThreadHandle)
       IntTimer.Enabled = True
       m_bThreadFlag = True
    End If
End Sub

Private Sub IntTimer_Timer()
Dim Ratio As Single
Dim strRatio(0 To 127) As String

    dwCurrentTime = GetTickCount()
        dwTime = dwCurrentTime - dwStartTime
        If (dwTime >= 1000) Then
            dwStartTime = dwCurrentTime
            For i = 0 To m_DIChanNum - 1
                strRatio(i) = Format(CLng(lEventCount(i)) / CSng(dwTime) * 1000#, "0")
                lEventCount(i) = 0
            Next i
            For i = 0 To m_DIChanNum - 1
            InterruptList.ListItems(i + 1).SubItems(3) = strRatio(i)
                
            Next i

            
        End If
End Sub

Private Sub ScanTimer_Timer()
    Dim DIValue As Integer
    Dim ptDioReadPortByte As PT_DioReadPortByte
    ptDioReadPortByte.Port = cmbPort.ListIndex
    ptDioReadPortByte.value = DRV_GetAddress(DIValue)
    m_ErrCde = DRV_DioReadPortByte(m_DriverHandle, ptDioReadPortByte)
    txtPortValue.Caption = Hex(DIValue)
End Sub

Private Sub txtFilterCounter_Change()
m_FilterCounter = CLng(txtFilterCounter.Text)
    If m_FilterCounter > 0 Then
       txtFilterFreq.Caption = Str(10000# / (CSng(m_FilterCounter) * 2#))
           ulDataLength = Len(m_FilterCounter)
       'Get the DI filter counter: Timer = Counter * 0.0001 * 2( 10M clock)
   m_ErrCde = DRV_DeviceSetProperty(m_DriverHandle, CFG_DiFilterIntervalCounter, m_FilterCounter, ulDataLength)
    Else
    txtFilterFreq.Caption = ""
    End If

End Sub