form1.frm

来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 492 行

VERSION 5.00
Begin VB.Form mainfrm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Advantech Driver DEMO: Digital Input with Timer Setting"
   ClientHeight    =   4860
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8235
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4860
   ScaleWidth      =   8235
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton CloseButton 
      Caption         =   "&Close"
      Height          =   495
      Left            =   6360
      TabIndex        =   28
      Top             =   3720
      Width           =   1575
   End
   Begin VB.CommandButton SelDevButton 
      Caption         =   "Select &Device"
      Height          =   495
      Left            =   6360
      TabIndex        =   27
      Top             =   2280
      Width           =   1575
   End
   Begin VB.CommandButton AboutCommand 
      Caption         =   "&About"
      Height          =   495
      Index           =   0
      Left            =   6360
      TabIndex        =   17
      Top             =   3000
      Width           =   1575
   End
   Begin VB.Frame Frame4 
      Caption         =   "Event Type Setting"
      Height          =   1815
      Left            =   6240
      TabIndex        =   16
      Top             =   120
      Width           =   1935
      Begin VB.CheckBox evtGroup1Check 
         Caption         =   "Event for Group 1"
         Height          =   375
         Left            =   120
         TabIndex        =   23
         Top             =   1320
         Width           =   1695
      End
      Begin VB.CheckBox evtGroup0Check 
         Caption         =   "Event for Group 0"
         Height          =   375
         Left            =   120
         TabIndex        =   22
         Top             =   840
         Width           =   1695
      End
      Begin VB.CheckBox evtIntCheck 
         Caption         =   "Event for Interrupt"
         Height          =   375
         Left            =   120
         TabIndex        =   21
         Top             =   360
         Width           =   1695
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "Interrupt Event"
      Height          =   3135
      Left            =   2880
      TabIndex        =   6
      Top             =   1200
      Width           =   3255
      Begin VB.CommandButton DisableCommand 
         Caption         =   "&Disable"
         Height          =   375
         Left            =   1800
         TabIndex        =   14
         Top             =   2400
         Width           =   975
      End
      Begin VB.CommandButton EnableCommand 
         Caption         =   "&Enable"
         Height          =   375
         Left            =   600
         TabIndex        =   13
         Top             =   2400
         Width           =   975
      End
      Begin VB.TextBox txtEventCount 
         BackColor       =   &H80000004&
         Height          =   405
         Left            =   720
         TabIndex        =   11
         Top             =   1800
         Width           =   1815
      End
      Begin VB.TextBox IntrptCountText 
         Height          =   375
         Left            =   1560
         TabIndex        =   10
         Text            =   "1"
         Top             =   1080
         Width           =   1335
      End
      Begin VB.OptionButton TimeCriticalOption 
         Caption         =   "Time Critical Priority"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   720
         Width           =   1695
      End
      Begin VB.OptionButton NormalOption 
         Caption         =   "Normal Priority"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   360
         Width           =   1695
      End
      Begin VB.Label Label7 
         Caption         =   "I/S"
         Height          =   255
         Left            =   2640
         TabIndex        =   12
         Top             =   1920
         Width           =   375
      End
      Begin VB.Label Label5 
         Caption         =   "Interrupt Count"
         Height          =   375
         Left            =   240
         TabIndex        =   9
         Top             =   1080
         Width           =   1215
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "Timer Number Setting"
      Height          =   3135
      Left            =   240
      TabIndex        =   1
      Top             =   1200
      Width           =   2415
      Begin VB.TextBox txtCount2 
         Height          =   285
         Left            =   1200
         TabIndex        =   20
         Text            =   "10"
         Top             =   1320
         Width           =   975
      End
      Begin VB.TextBox txtCount1 
         Height          =   285
         Left            =   1200
         TabIndex        =   5
         Text            =   "10"
         Top             =   840
         Width           =   975
      End
      Begin VB.TextBox txtCount0 
         Height          =   285
         Left            =   1200
         TabIndex        =   3
         Text            =   "10"
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label6 
         Caption         =   "not take effect.(10MHz/Cnt1)"
         Height          =   255
         Left            =   120
         TabIndex        =   26
         Top             =   2400
         Width           =   2175
      End
      Begin VB.Label Label4 
         Caption         =   "the value in Counter 0 would"
         Height          =   375
         Left            =   120
         TabIndex        =   25
         Top             =   2160
         Width           =   2175
      End
      Begin VB.Label Label3 
         Caption         =   "If you didn't select Cascade,"
         Height          =   375
         Left            =   120
         TabIndex        =   24
         Top             =   1920
         Width           =   2175
      End
      Begin VB.Label Label11 
         Caption         =   " Count 2:"
         Height          =   255
         Left            =   360
         TabIndex        =   19
         Top             =   1320
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "   Count 1:"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   840
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "   Count 0:"
         Height          =   255
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Device Selection"
      Height          =   975
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   5775
      Begin VB.TextBox txtDevice 
         BackColor       =   &H80000004&
         Height          =   375
         Left            =   240
         TabIndex        =   18
         Top             =   360
         Width           =   5415
      End
   End
   Begin VB.Label Label10 
      Caption         =   "Hints : I/S -> Interrupt Event count per Second, and All Counter input should be in 2 - 65535"
      Height          =   255
      Left            =   240
      TabIndex        =   15
      Top             =   4560
      Width           =   7575
   End
End
Attribute VB_Name = "mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub AboutCommand_Click(Index As Integer)
    frmAbout.Show vbModal
End Sub


Private Sub CloseButton_Click()
    Unload Me
End Sub

Private Sub EnableCommand_Click()
    Dim txtCounterVal As Long
    Dim ThreadID As Long
        
    If gbThreadTerminated = False Then
        Exit Sub
    End If
        
    'Check to see whether Interrupt Count is valid
    If (Not IsNumeric(IntrptCountText.Text)) Then
        MsgBox "Invalid Interrupt Count", vbOKOnly, "Error!"
        Exit Sub
    End If

    ptEnableEvent.EventType = 0
    If (evtIntCheck = Checked) Then
        ptEnableEvent.EventType = ADS_EVT_INTERRUPT
    End If
    
    If (evtGroup0Check = Checked) Then
        ptEnableEvent.EventType = ptEnableEvent.EventType Or ADS_EVT_PORT0
    End If
    
    If (evtGroup1Check = Checked) Then
        ptEnableEvent.EventType = ptEnableEvent.EventType Or ADS_EVT_PORT1
    End If
    
    'Counter Value Set
    ptEnableEvent.Enabled = 1
    ptTimerCountSetting.counter = 2
    ptTimerCountSetting.Count = txtCount2.Text
    ErrCde = DRV_TimerCountSetting(DeviceHandle, ptTimerCountSetting)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        Exit Sub
    End If
    
    txtCounterVal = (txtCount0.Text * 2 ^ 16) + txtCount1.Text
    ptTimerCountSetting.counter = 1
    ptTimerCountSetting.Count = txtCounterVal
    ErrCde = DRV_TimerCountSetting(DeviceHandle, ptTimerCountSetting)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
    Exit Sub
    End If
    
    ptTimerCountSetting.counter = 0
    ErrCde = DRV_TimerCountSetting(DeviceHandle, ptTimerCountSetting)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        Exit Sub
    End If
    ptEnableEvent.Count = IntrptCountText.Text

    'Enable Event
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        Exit Sub
    End If
    
    'Create Interrupt Event handler thread and suspend it
    ThreadHandle = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, ThreadID)
    If (ThreadHandle = 0) Then
        MsgBox "Create Thread Failed!", vbOKOnly, "Error!!"
        DRV_DeviceClose DeviceHandle
        Exit Sub
    End If
    
    'Set thread priority
    If (Not bTimeCritical) Then
        'Using THREAD_PRIORITY_NORMAL for interrupt event handling routine,
        'you can get about 1.2 ~ 1.5 KHz response ratio by using PENTIUM 200 MMX PC.
        SetThreadPriority ThreadHandle, THREAD_PRIORITY_NORMAL
    Else
        'Using THREAD_PRIORITY_TIME_CRITICAL for interrupt event handling routine,
        'you can get about 20 KHz response ratio by using PENTIUM 200 MMX PC.
        SetThreadPriority ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL
    End If
    
    'Awake thread
    ResumeThread ThreadHandle
    
    'Set thread running flag
    gbStopThread = False
    gbThreadTerminated = True
    DisableCommand.Enabled = True
    EnableCommand.Enabled = False
    CloseButton.Enabled = False
    SelDevButton.Enabled = False
End Sub

Private Sub DisableCommand_Click()
    gbStopThread = True
    Dim WAIT_FAILED As Long
    
    Dim ExitCode As Long
    If (ThreadHandle <> 0) Then
        GetExitCodeThread ThreadHandle, ExitCode
    End If
    If (ExitCode = STILL_ACTIVE) Then
        TerminateThread ThreadHandle, ExitCode
    End If
    'Wait for the termination of Interrupt Event Handling thread
    If (WAIT_FAILED = WaitForSingleObject(DeviceHandle, 500)) Then
      Debug.Print "WaitForSingleObject -- Failed!"
    End If
    
    
    ptEnableEvent.Enabled = False
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT
    
    'Disable Interrupt Event
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      MsgBox szErrMsg, vbOKOnly, "Error!!"
    End If
   
    EnableCommand.Enabled = True
    DisableCommand.Enabled = False
    CloseButton.Enabled = True
    CloseHandle (DeviceHandle)
    
    If gbRun = False Then
        SelDevButton.Enabled = True
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   ' If the interrupt event handling thread is running, don't close the program
    If gbThreadTerminated = False Then
      MsgBox "Can't be close now!", vbOKOnly Or vbExclamation, "Error"
      Cancel = 1
        Exit Sub
    End If
    
    If DeviceHandle <> 0 Then
        DRV_DeviceClose DeviceHandle
    End If
    
    TerminateProcess GetCurrentProcess, ByVal 0&
    
End Sub

Private Sub SelDevButton_Click()
    mainfrm.Visible = False
    SelectDevice
    mainfrm.Visible = True
End Sub

Private Sub TimeCriticalOption_Click()
    bTimeCritical = True
End Sub

Private Sub NormalOption_Click()
    bTimeCritical = False
End Sub
Private Sub Form_Load()
    gbThreadTerminated = True
    gbStopThread = True
    SelectDevice
    NormalOption.value = Not bTimeCritical
    DisableCommand.Enabled = False
End Sub

Private Sub ScanTimer_Timer()
    Dim DiValue As Integer
    Dim TempBit As Integer
    
    lpDioReadPort.Port = nChannel
    lpDioReadPort.value = DRV_GetAddress(DiValue)
    ErrCde = DRV_DioReadPortByte(DeviceHandle, lpDioReadPort)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
    Exit Sub
    End If
    
End Sub

Public Function SelectDevice()
    Dim DeviceNum As Long
    Dim DeviceName As String * 50
    
    '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
            MsgBox szErrMsg, vbOKOnly, "Error!!"
            Exit Function
        End If
    End If
   'Show device list
    ErrCde = DRV_SelectDevice(Me.hWnd, False, DeviceNum, DeviceName)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        Exit Function
    End If
    
    'Open device
    ErrCde = DRV_DeviceOpen(DeviceNum, DeviceHandle)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       MsgBox szErrMsg, vbOKOnly, "Error!!"
       Exit Function
    End If

    'Get device features
    ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
    ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      MsgBox szErrMsg, vbOKOnly, "Error!!"
      Exit Function
    End If
    
    'Set parameter
    mainfrm.txtDevice.Text = DeviceName
End Function