frmmain.frm

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

FRM
572
字号
   End
   Begin VB.Label Label1 
      Caption         =   "Hints: This Demo is for PCL733 only.                               Events/S==>Interrupt Event Per Second"
      Height          =   495
      Left            =   120
      TabIndex        =   17
      Top             =   3480
      Width           =   3495
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdClose_Click()
    Dim Response As Long
    
    If gbStart Or gbEnableDI0 Or gbEnableDI16 Then
        MsgBox "The timer or the event is enabled, stop them before close device", vbExclamation, "Demo Message"
        Exit Sub
    End If
    
    'if the device is opened,close it.
    If (DeviceHandle <> 0) Then
        ErrCde = DRV_DeviceClose(DeviceHandle)
        If (ErrCde <> 0) Then
            DRV_GetErrorMessage ErrCde, szErrMsg
            Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
            Exit Sub
        End If
    End If
    
    End
End Sub

Private Sub cmdDisableDI0_Click()
    Dim EventSetting As PT_EnableEvent
    
    EventSetting.Enabled = 0
    EventSetting.Count = Val(txtEvtCntDI0.Text)
    EventSetting.EventType = ADS_EVT_INTERRUPT_DI0
    
    ErrCde = DRV_EnableEvent(DeviceHandle, EventSetting)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       MsgBox szErrMsg, vbOKOnly, "Error!!"
       Exit Sub
     End If
    
    gbEnableDI0 = False
    If (gbEnableDI16 = False) Then
        ThreadHandle = 0
    End If
        
    cmdEnableDI0.Enabled = True
    cmdDisableDI0.Enabled = False
    
    ctlEvtFrqDI0 = 0
End Sub

Private Sub cmdDisableDI16_Click()
    Dim EventSetting As PT_EnableEvent
    
    EventSetting.Enabled = 0
    EventSetting.Count = Val(txtEvtCntDI16.Text)
    EventSetting.EventType = ADS_EVT_INTERRUPT_DI16
    
    ErrCde = DRV_EnableEvent(DeviceHandle, EventSetting)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       MsgBox szErrMsg, vbOKOnly, "Error!!"
       Exit Sub
     End If
    
    gbEnableDI16 = False
    If (gbEnableDI0 = False) Then
        ThreadHandle = 0
    End If
        
    cmdEnableDI16.Enabled = True
    cmdDisableDI16.Enabled = False
    
    ctlEvtFrqDI16 = 0
End Sub

Private Sub cmdEnableDI0_Click()
    Dim EventSetting As PT_EnableEvent
    
    If (Val(txtEvtCntDI0) < 1 Or Val(txtEvtCntDI0) > 10000) Then
        MsgBox "Event Count must be a integer between 1 and 10000", vbInformation, "Demo Message"
        txtEvtCntDI0 = 1
        Exit Sub
    End If
    
    EventSetting.Enabled = 1
    EventSetting.Count = txtEvtCntDI0.Text
    EventSetting.EventType = ADS_EVT_INTERRUPT_DI0
    
    ErrCde = DRV_EnableEvent(DeviceHandle, EventSetting)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       MsgBox szErrMsg, vbOKOnly, "Error!!"
       Exit Sub
     End If
    
     gbEnableDI0 = True
    
    If (gbEnableDI16 = False) Then
        ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, ThreadID)
        If (ThreadHandle = 0) Then
            MsgBox "Create Thread Failed!", vbOKOnly, "Error!!"
            Call cmdDisableDI0_Click
            Exit Sub
        End If
        SetThreadPriority ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL
        ResumeThread ThreadHandle
    End If
    

    
    cmdEnableDI0.Enabled = False
    cmdDisableDI0.Enabled = True
    
End Sub

Private Sub cmdEnableDI16_Click()
    Dim EventSetting As PT_EnableEvent
    If (Val(txtEvtCntDI16) < 1 Or Val(txtEvtCntDI16) > 10000) Then
        MsgBox "Event Count must be a integer between 1 and 10000", vbInformation, "Demo Message"
        txtEvtCntDI16 = 1
        Exit Sub
    End If
    
    EventSetting.Enabled = 1
    EventSetting.Count = Val(txtEvtCntDI16.Text)
    EventSetting.EventType = ADS_EVT_INTERRUPT_DI16
    
    ErrCde = DRV_EnableEvent(DeviceHandle, EventSetting)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       MsgBox szErrMsg, vbOKOnly, "Error!!"
       Exit Sub
     End If
     
    gbEnableDI16 = True
     
    If (gbEnableDI0 = False) Then
        ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, ThreadID)
        If (ThreadHandle = 0) Then
            MsgBox "Create Thread Failed!", vbOKOnly, "Error!!"
            Call cmdDisableDI16_Click
            Exit Sub
        End If
        SetThreadPriority ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL
        ResumeThread ThreadHandle
    End If
    

    cmdEnableDI16.Enabled = False
    cmdDisableDI16.Enabled = True
    
End Sub

Private Sub cmdSelectDevice_Click()
    Dim DeviceNum As Long
    Dim DeviceName As String * 256
    Dim Response As Long
    
    If gbStart Or gbEnableDI0 Or gbEnableDI16 Then
        MsgBox "The timer or the event is enabled, stop them before select device", vbExclamation, "Demo Message"
        Exit Sub
    End If
    'If we already opened a device, so close it before open new device
    If (DeviceHandle <> 0) Then
        ErrCde = DRV_DeviceClose(DeviceHandle)
        If (ErrCde <> 0) Then
            DRV_GetErrorMessage ErrCde, szErrMsg
            Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
            Exit Sub
        End If
    End If
   'Show device list
   DeviceNum = 0
   
   ErrCde = DRV_SelectDevice(Me.hWnd, False, DeviceNum, DeviceName)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Sub
    End If
    
    ctlDeviceName = DeviceName
    
    'Open device
    ErrCde = DRV_DeviceOpen(DeviceNum, DeviceHandle)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
       Exit Sub
    End If
    
    'Get device features
    ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
    ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
      DRV_DeviceClose DeviceHandle
      Exit Sub
    End If
    
    ctlSpinPort.Max = lpDevFeatures.usMaxDIChl / 8 - 1
    ctlSpinPort.Min = 0
    ctlSpinPort.SmallChange = 1
    ctlSpinPort.value = ctlSpinPort.Max
    Call ctlSpinPort_Change
    
    cmdStart.Enabled = True
    cmdEnableDI0.Enabled = True
    cmdEnableDI16.Enabled = True
    
End Sub

Private Sub cmdStart_Click()
    If (Val(txtScantime) < 1 Or Val(txtScantime) > 10000) Then
        MsgBox "Scantime must be a integer between 1 and 10000", vbInformation, "Demo Message"
        txtScantime = 1000
        Exit Sub
    End If
    Timer1.Interval = Val(txtScantime)
    cmdStart.Enabled = False
    cmdStop.Enabled = True
    Timer1.Enabled = True
    gbStart = True
End Sub

Private Sub cmdStop_Click()
    cmdStop.Enabled = False
    cmdStart.Enabled = True
    Timer1.Enabled = False
    gbStart = False
End Sub

Private Sub ctlSpinPort_Change()
    Port.Text = ctlSpinPort.Max - ctlSpinPort.value
End Sub

Private Sub Form_Load()
DeviceHandle = 0
gbStart = False
gbEnableDI0 = False
gbEnableDI16 = False
ThreadHandle = 0

Call cmdSelectDevice_Click

End Sub

Private Sub Port_Change()
If (Val(Port) > ctlSpinPort.Max Or Val(Port) < ctlSpinPort.Min) Then
   Port = 0
Else
    nChannel = Val(Port)
End If
End Sub

Private Sub Timer1_Timer()
    Dim gwValue As Integer     'input value
    Dim szBuf As String * 10
    
    lpDioReadPort.Port = nChannel
    lpDioReadPort.value = DRV_GetAddress(gwValue)

    ErrCde = DRV_DioReadPortByte(DeviceHandle, lpDioReadPort)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Driver Message"
        Call cmdStop_Click
    Else
        szBuf = Format(Hex(gwValue), "0#")
        ctlData = szBuf
    End If
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?