fstartup.frm

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

   Begin VB.Label Label4 
      Caption         =   "ms"
      Height          =   225
      Left            =   4350
      TabIndex        =   37
      Top             =   1305
      Width           =   330
   End
End
Attribute VB_Name = "mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Function HexToInt(str As String) As Long
    HexToInt = Val("&H" + str)
End Function

Private Sub AboutButton_Click()
    frmAbout.Show vbModal
End Sub



Private Sub CloseButton_Click()
   Unload Me
End Sub

Private Sub cmdPatternMatch_Click()
    fPMConfig.giPA0Mask = HexToInt(txtPA0Mask.Text)
    fPMConfig.giPA0Value = HexToInt(txtPA0Value.Text)
    
    fPMConfig.giPA4Mask = HexToInt(txtPA4Mask.Text)
    fPMConfig.giPA4Value = HexToInt(txtPA4Value.Text)
    
    fPMConfig.Show 1
    
    txtPA0Mask.Text = Hex(fPMConfig.giPA0Mask)
    txtPA0Value.Text = Hex(fPMConfig.giPA0Value)
    
    txtPA4Mask.Text = Hex(fPMConfig.giPA4Mask)
    txtPA4Value.Text = Hex(fPMConfig.giPA4Value)
End Sub

Private Sub cmdStatusChange_Click()
    fSCConfig.giPB0Value = HexToInt(txtPB0Mask.Text)
    fSCConfig.giPB4Value = HexToInt(txtPB4Mask.Text)
    
    fSCConfig.Show 1
    
    txtPB0Mask.Text = Hex(fSCConfig.giPB0Value)
    txtPB4Mask.Text = Hex(fSCConfig.giPB4Value)
End Sub

Private Sub EnableCommand_Click()
    Dim Response As Long, ThreadID As Long
    Dim iTmp As Integer
    
    If gbThreadTerminated = False Then
        Exit Sub
    End If
    '1. Open the device
     ErrCde = DRV_DeviceOpen(DeviceNum, DeviceHandle)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
       Exit Sub
    End If

        
  '2. If want Enable Pattern Match event feature, enable it
  iTmp = Val("&h" + txtPA0Mask.Text) + Val("&h" + txtPA4Mask.Text) * 256
  If iTmp <> 0 Then
    '2.1 Fill Pattern match feature needs data
    With ptDiPattern
      .EventType = ADS_EVT_PATTERNMATCH
      .EventEnabled = 1
      .Count = 1
      .EnableMask = iTmp
      .PatternValue = Val("&h" + txtPA0Value.Text) + Val("&H" + txtPA4Value.Text) * 256
    End With

    '2.2 Start up Event match function
    ErrCde = DRV_EnableEventEx(DeviceHandle, ptDiPattern)
   If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
    End If

    gbUseEvent = True
  End If

  '3. Enable Status Change event feature
  iTmp = HexToInt(txtPB0Mask.Text) + HexToInt(txtPB4Mask.Text) * 256
  If iTmp <> 0 Then

    '3.1 Fill status change need data
    With ptDiStatus
      .EventType = ADS_EVT_STATUSCHANGE
      .EventEnabled = 1
      .Count = 1
      .EnableMask = iTmp
    End With

    '3.2 start function
    ErrCde = DRV_EnableEventEx(DeviceHandle, ptDiStatus)
  If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
    End If
    gbUseEvent = True
  End If 'End of starting Status change
  If (radPCEnable.value) Then
  
    ptEnableEvent.Enabled = 1
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT
    ptEnableEvent.Count = 1
    
    '4 Enable Interrupt Event
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        DRV_DeviceClose (DeviceHandle)
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        Exit Sub
    End If
   End If
   
   glIntCount = 0
   glSCCount = 0
   glPMCount = 0
    txtINTCount.Text = str(glIntCount)    'display on screen
  txtSCCount.Text = str(glSCCount)
  txtPMCount.Text = str(glPMCount)
  txtData.Text = Hex(0)

    '5 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
       Response = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_NORMAL)
    
    
    'Awake thread
    Response = ResumeThread(ThreadHandle)
    ScanTimer.Enabled = True
    ScanTimer.Interval = txtScanTime.Text
    
    
    
    '6 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
    Dim ExitCode As Long
    
    gbStopThread = True
    ScanTimer.Enabled = False
    
     Sleep (200)
      'terminate the thread
     If (ThreadHandle <> 0) Then
       GetExitCodeThread ThreadHandle, ExitCode
     End If
    If (ExitCode = STILL_ACTIVE) Then
        TerminateThread ThreadHandle, ExitCode
    End If
    
      If gbUseEvent Then
      '2.1 fill table
      With ptDiStatus
        .EventType = 0
        .EventEnabled = 0
      End With

      '2.2 stop this function
      ErrCde = DRV_EnableEventEx(DeviceHandle, ptDiStatus)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    End If
      
      gbUseEvent = False
    End If

    ptEnableEvent.Enabled = 0
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT
    
    '3 Disable Interrupt Event
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    End If
    ErrCde = DRV_DeviceClose(DeviceHandle)
    If (ErrCde <> 0) Then
         DRV_GetErrorMessage ErrCde, szErrMsg
         Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
         Exit Sub
    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 Form_Unload(Cancel As Integer)
    TerminateProcess GetCurrentProcess, 0
End Sub

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


Private Sub Form_Load()
    gbThreadTerminated = True
    gbStopThread = True
    SelectDevice
     DisableCommand.Enabled = False
End Sub

Private Sub ScanTimer_Timer()
    Dim DiValue As Integer
    Dim TempBit As Integer
    
    lpDioReadPort.Port = cmbDIPort.ListIndex
    lpDioReadPort.value = DRV_GetAddress(DiValue)
    ErrCde = DRV_DioReadPortByte(DeviceHandle, lpDioReadPort)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        MsgBox szErrMsg, vbOKOnly, "Error!!"
        DisableCommand_Click
    Exit Sub
    End If
  txtINTCount.Text = str(glIntCount)    'display on screen
  txtSCCount.Text = str(glSCCount)
  txtPMCount.Text = str(glPMCount)
  txtData.Text = Hex(DiValue)
        
   
End Sub



Public Function SelectDevice()
    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
    txtScanTime.Text = "1000"
    ErrCde = DRV_DeviceClose(DeviceHandle)


End Function