form1.frm

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

            Height          =   225
            Index           =   7
            Left            =   120
            Picture         =   "Form1.frx":2E0E
            Top             =   240
            Width           =   225
         End
      End
      Begin VB.ComboBox cmbDIPort 
         Height          =   315
         Left            =   1200
         Style           =   2  'Dropdown List
         TabIndex        =   30
         Top             =   840
         Width           =   975
      End
      Begin VB.Timer ScanTimer 
         Left            =   2760
         Top             =   240
      End
      Begin VB.CommandButton StopCommand 
         Cancel          =   -1  'True
         Caption         =   "&Stop"
         Enabled         =   0   'False
         Height          =   375
         Left            =   1800
         TabIndex        =   7
         Top             =   2520
         Width           =   975
      End
      Begin VB.CommandButton StartCommand 
         Caption         =   "&Start"
         Height          =   375
         Left            =   360
         TabIndex        =   6
         Top             =   2520
         Width           =   975
      End
      Begin VB.TextBox ChannelData 
         BackColor       =   &H80000004&
         Height          =   285
         Left            =   1200
         TabIndex        =   5
         Top             =   1200
         Width           =   975
      End
      Begin VB.TextBox ScanTime 
         Height          =   285
         Left            =   1200
         TabIndex        =   3
         Text            =   "500"
         Top             =   480
         Width           =   975
      End
      Begin VB.Label Label11 
         Caption         =   "Port:"
         Height          =   255
         Left            =   720
         TabIndex        =   29
         Top             =   840
         Width           =   375
      End
      Begin VB.Label Label4 
         Caption         =   "hex"
         Height          =   255
         Left            =   2280
         TabIndex        =   12
         Top             =   1200
         Width           =   255
      End
      Begin VB.Label Label3 
         Caption         =   "ms"
         Height          =   255
         Left            =   2280
         TabIndex        =   11
         Top             =   480
         Width           =   255
      End
      Begin VB.Label Label2 
         Caption         =   "         Data:"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   1200
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "Scan Time:"
         Height          =   255
         Left            =   240
         TabIndex        =   2
         Top             =   480
         Width           =   855
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Device Selection"
      Height          =   975
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   3735
      Begin VB.TextBox txtDevice 
         BackColor       =   &H80000004&
         Height          =   375
         Left            =   240
         TabIndex        =   25
         Top             =   360
         Width           =   3255
      End
   End
   Begin VB.Label Label10 
      Caption         =   "Hints : I/S -> Interrupt Event count per Second"
      Height          =   255
      Left            =   360
      TabIndex        =   24
      Top             =   4320
      Width           =   3735
   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 AboutButton_Click()
    frmAbout.Show vbModal
End Sub



Private Sub CloseButton_Click()
   Unload Me
End Sub

Private Sub EnableCommand_Click()
    Dim Response As Long, 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.Enabled = 1
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT
    ptEnableEvent.Count = IntrptCountText.Text

    'Enable Interrupt 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
        Response = MsgBox("Create Thread Failed!", vbOKOnly, "Error!!")
        Response = DRV_DeviceClose(DeviceHandle)
        Exit Sub
    End If
    
    'Set thread priority
    If (Not bTimeCritical) Then
        Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_NORMAL)
    Else
        Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL)
    End If
    
    'Awake thread
    Response = 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()
    Dim WAIT_FAILED As Long, Response As Long
    
    gbStopThread = True
    'Wait for the termination of Interrupt Event Handling thread
    If (WAIT_FAILED = WaitForSingleObject(DeviceHandle, 5000)) Then
    
        Debug.Print "WaitForSingleObject -- Failed!"
    End If
    CloseHandle (DeviceHandle)
    
    ptEnableEvent.Enabled = 0
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT
    
    'Disable Interrupt Event
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    End If
   
    EnableCommand.Enabled = True
    DisableCommand.Enabled = False
    CloseButton.Enabled = True
    
    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 closed now!", vbOKOnly Or vbExclamation, "Error"
      Cancel = 1
        Exit Sub
    End If
    
    If DeviceHandle <> 0 Then
        DRV_DeviceClose DeviceHandle
    End If
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 = True
    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!!"
        StopCommand_Click
    Exit Sub
    End If
    
    ChannelData.Text = Hex(DiValue)
    UpdateLed (DiValue)
End Sub
Private Function UpdateLed(ByVal DiValue As Integer)
    Dim i, iShift As Integer

    iShift = 1

    'Check every Digtial data bit
    For i = 0 To 7
        'Check, it is change to 1 or 0
        If (DiValue And iShift) = iShift Then
            'It changes to 1, light the LED
            Gray_LED(i).Visible = False
            Red_LED(i).Visible = True
        Else
            'It changes to 0, turn off the LED
            Gray_LED(i).Visible = True
            Red_LED(i).Visible = False
       End If
    'Check next bit
    iShift = iShift * 2
    Next
    
End Function

Private Sub StartCommand_Click()
    'Check to see whether Scan Interval is valid
    If (Not IsNumeric(ScanTime.Text)) Then
        MsgBox "Invalid Scan Interval", vbOKOnly, "Error!"
        Exit Sub
    End If

    nChannel = cmbDIPort.ListIndex
    ScanTimer.Interval = ScanTime.Text
    ScanTimer.Enabled = True
    StopCommand.Enabled = True
    ScanTime.Enabled = False
    StartCommand.Enabled = False
    SelDevButton.Enabled = False
    gbRun = True
    
End Sub

Private Sub StopCommand_Click()
     
    ScanTimer.Enabled = False
    ChannelData.Text = ""
    ScanTime.Enabled = True
    StartCommand.Enabled = True
    StopCommand.Enabled = False
    gbRun = False
    
    If gbStopThread = True Then
        SelDevButton.Enabled = True
    End If
End Sub

Public Function SelectDevice()
    Dim DeviceNum As Long
    Dim DeviceName As String * 50
    Dim Response As Long
    
    '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 Function
        End If
    End If
   'Show device list
    ErrCde = DRV_SelectDevice(Me.hWnd, False, DeviceNum, DeviceName)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Function
    End If
    
    'Open device
    ErrCde = DRV_DeviceOpen(DeviceNum, DeviceHandle)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       Response = 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
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
      Exit Function
    End If
    
    'Set parameter
    Dim i As Integer
    cmbDIPort.Clear
    For i = 0 To lpDevFeatures.usMaxDIChl / 8
       cmbDIPort.AddItem (i)
    Next i
     mainfrm.txtDevice.Text = DeviceName
    cmbDIPort.ListIndex = 0
    ScanTime.Text = "1000"
    

End Function