mainform.frm

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

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
    gCounter = 0
    gEventCount = 0
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 section 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
    ptEnableEvent.Count = txtInterruptCount.Text
    
    Dim EventType As Long
    EventType = ADS_EVT_INTERRUPT_DI0
    For i = 0 To 7
      If DI.Item(i).value = 1 Then
        ptEnableEvent.EventType = EventType + i
        '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
      End If
      DI.Item(i).Enabled = False
    Next i
    
    
    '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
    Dim EventType As Long
    
    ptEnableEvent.Enabled = Flase
    EventType = ADS_EVT_INTERRUPT_DI0
    
    'Disable Interrupt Event
    For i = 0 To 7
      If DI.Item(i).value = 1 Then
        ptEnableEvent.EventType = EventType + i
        ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
        If (ErrCde <> 0) Then
            DRV_GetErrorMessage ErrCde, szErrMsg
            Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        End If
      End If
      DI.Item(i).Enabled = True
    Next i
    
    Sleep (100)
    'Set thread running flag
    gbStopThread = True
    gbThreadTerminated = False
    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
    cmbChannel.Clear
    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