mainform.frm

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

         End
         Begin VB.TextBox txtIntData 
            Alignment       =   1  'Right Justify
            BackColor       =   &H8000000F&
            ForeColor       =   &H80000002&
            Height          =   285
            Left            =   840
            TabIndex        =   34
            Top             =   960
            Width           =   1455
         End
         Begin VB.TextBox txtEventCount 
            Alignment       =   1  'Right Justify
            BackColor       =   &H8000000F&
            ForeColor       =   &H80000002&
            Height          =   285
            Left            =   840
            TabIndex        =   33
            Top             =   600
            Width           =   1455
         End
         Begin VB.Label Label10 
            Caption         =   "Event:"
            Height          =   255
            Left            =   120
            TabIndex        =   41
            Top             =   600
            Width           =   495
         End
         Begin VB.Label Label5 
            Caption         =   "Interrupt Count :"
            Height          =   255
            Left            =   120
            TabIndex        =   39
            Top             =   240
            Width           =   1335
         End
         Begin VB.Label Label6 
            Caption         =   "Counts:"
            Height          =   255
            Left            =   120
            TabIndex        =   38
            Top             =   960
            Width           =   495
         End
         Begin VB.Label Label7 
            Caption         =   "I/S"
            Height          =   252
            Left            =   2400
            TabIndex        =   37
            Top             =   600
            Width           =   252
         End
         Begin VB.Label Label8 
            Caption         =   "T"
            Height          =   252
            Left            =   2400
            TabIndex        =   36
            Top             =   960
            Width           =   252
         End
      End
      Begin VB.Frame Frame2 
         Caption         =   "Priority"
         Height          =   615
         Left            =   240
         TabIndex        =   29
         Top             =   240
         Width           =   3615
         Begin VB.OptionButton NormalOption 
            Caption         =   "Normal"
            Height          =   255
            Left            =   120
            TabIndex        =   31
            Top             =   240
            Value           =   -1  'True
            Width           =   1095
         End
         Begin VB.OptionButton CriticalOption 
            Caption         =   "Time Critical"
            Height          =   255
            Left            =   2160
            TabIndex        =   30
            Top             =   240
            Width           =   1335
         End
      End
      Begin VB.CommandButton DisableButton 
         Caption         =   "Disable"
         Enabled         =   0   'False
         Height          =   375
         Left            =   3120
         TabIndex        =   14
         Top             =   1800
         Width           =   855
      End
      Begin VB.CommandButton EnableButton 
         Caption         =   "Enable"
         Height          =   375
         Left            =   3120
         TabIndex        =   13
         Top             =   1200
         Width           =   855
      End
      Begin VB.Label Label9 
         Caption         =   "Hints--> I/S: Interrupt Event count per Second"
         Height          =   255
         Left            =   240
         TabIndex        =   40
         Top             =   2520
         Width           =   3615
      End
   End
   Begin VB.Label NOTE 
      Caption         =   "Note: Please compile and run this sample using Visual Basic 5.0"
      ForeColor       =   &H000000C0&
      Height          =   255
      Left            =   120
      TabIndex        =   42
      Top             =   4080
      Visible         =   0   'False
      Width           =   6135
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub AboutButton_Click()
    
    frmAbout.Show vbModal
End Sub


Private Sub CloseButton_Click()
    ' If the interrupt event handling thread is running, don't close the program
    If gbThreadTerminated = False Then
        Exit Sub
    End If
    
    If DeviceHandle <> 0 Then
        Response = DRV_DeviceClose(DeviceHandle)
    End If
    
    End
    
End Sub

Private Sub cmbChannel_Change()
    nChannel = cmbChannel.ListIndex
End Sub

Private Sub CriticalOption_Click()
    bTimeCritical = True
    NormalOption.value = False
    CriticalOption.value = True
End Sub


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

Private Sub EnableButton_Click()
    If gbThreadTerminated = False Then
        Exit Sub
    End If
        
    'Check to see whether Interrupt Count is valid
    If (Not IsNumeric(txtInterruptCount.Text)) Then
        Response = MsgBox("Invalid Interrupt Count", vbOKOnly, "Error!")
        Exit Sub
    End If

    'hanlu added
    '#######################################################
    '*******************************************************
    '                                                      '
    '    Important Notice                                  '
    '                                                      '
    '*******************************************************
    '#######################################################
    'this status can not be true or false
    'must be 1 or 0
    'the season is the dll wrote by c/c++
    'value of TRUE is 1 in c/c++,but it is -1 in vb
    'value of FALSE is 0 in Both c/c++ and vb
    '
    ptEnableEvent.Enabled = 1    'not be true
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT_DI0
    ptEnableEvent.Count = txtInterruptCount.Text

    'Enable Interrupt Event
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = 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(DeviceHanle)
        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)
    ShowTimer.Enabled = True
    'Set thread running flag
    gbStopThread = False
    gbThreadTerminated = True


    DisableButton.Enabled = True
    EnableButton.Enabled = False
    CloseButton.Enabled = False
    SelectButton.Enabled = False
End Sub
Private Sub DisableButton_Click()
    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)
     ShowTimer.Enabled = False
    ptEnableEvent.Enabled = 0
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT_DI0
    
    'Disable Interrupt Event
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    End If
   
    EnableButton.Enabled = True
    DisableButton.Enabled = False
    CloseButton.Enabled = True
    
    If gbRun = False Then
        SelectButton.Enabled = True
    End If
    
   
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
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        StopButton_Click
    Exit Sub
    End If
    
    txtChannelData.Text = Hex(DiValue)
    UpdateLed (DiValue)
End Sub

Private Sub SelectButton_Click()
    frmMain.Visible = False
    SelectDevice
    frmMain.Visible = True
End Sub



Private Sub ShowTimer_Timer()
    frmMain.txtEventCount.Text = gEventCount
        frmMain.txtIntData.Text = gCounter
End Sub

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

    nChannel = cmbChannel.ListIndex
    ScanTimer.Interval = txtInterval.Text
    ScanTimer.Enabled = True
    StopButton.Enabled = True
    txtInterval.Enabled = False
    StartButton.Enabled = False
    SelectButton.Enabled = False
    gbRun = True
End Sub

Private Sub StopButton_Click()
    Dim i As Integer
    
    'Turn off LED
    For i = 0 To 7
        Gray_LED(i).Visible = True
        Red_LED(i).Visible = False
    Next i
    
    ScanTimer.Enabled = False
    txtChannelData.Text = ""
    txtInterval.Enabled = True
    StartButton.Enabled = True
    StopButton.Enabled = False
    gbRun = False
    
    If gbStopThread = True Then
        SelectButton.Enabled = True
    End If
    
    
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


Public Function SelectDevice()
    Dim DeviceNum As Long
    Dim DeviceName As String * 50
    Dim i As Integer
    
    '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
    i = 0
    While (i < (lpDevFeatures.usMaxDIChl / 8))
        cmbChannel.AddItem (Str(i))
        i = i + 1
    Wend
    cmbChannel.ListIndex = 0
    
    frmMain.CurrentDevice.Text = DeviceName
'    ChannelSlider.value = 0
    txtInterval.Text = "1000"
   ' txtChannel.Text = "0"

End Function