frmrun.frm

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

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmRun 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Advantech Demo: Converting & transfering data"
   ClientHeight    =   1830
   ClientLeft      =   2760
   ClientTop       =   2400
   ClientWidth     =   4860
   ControlBox      =   0   'False
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1830
   ScaleWidth      =   4860
   ShowInTaskbar   =   0   'False
   Begin VB.Timer tmrChkStatus 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   360
      Top             =   960
   End
   Begin VB.CommandButton butTerminal 
      Caption         =   "&Terminal"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1440
      TabIndex        =   0
      Top             =   960
      Width           =   2175
   End
   Begin ComctlLib.ProgressBar prgsConvCount 
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   240
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   661
      _Version        =   327682
      Appearance      =   1
   End
End
Attribute VB_Name = "frmRun"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim ptAiCheck  As PT_FAICheck
Dim iActiveBuf As Integer
Dim iStopped As Integer
Dim lRetrieved As Long
Dim iOverrun As Integer
Dim iHalfReady As Integer


Private Sub butTerminal_Click()
    Unload frmRun
End Sub

Private Sub Form_Activate()
     
    'Fill FAI check structure
    'This used in Timer cyclic checking
    ptAiCheck.ActiveBuf = DRV_GetAddress(iActiveBuf)
    ptAiCheck.stopped = DRV_GetAddress(iStopped)
    ptAiCheck.retrieved = DRV_GetAddress(lRetrieved)
    ptAiCheck.Overrun = DRV_GetAddress(iOverrun)
    ptAiCheck.HalfReady = DRV_GetAddress(iHalfReady)

End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim ptFAIWatchdogCheck As PT_FAIWatchdogCheck
Dim iWhichBuf As Integer
Dim iTriggered As Integer
Dim iTrigChan As Integer
Dim lTrigIndex As Long
Dim fTrigData As Single
Dim iRawData As Integer

Dim ptFAIData As PT_FAITransfer
Dim sDataBuffer() As Single
Dim iDataBuffer() As Integer
Dim lOverrun As Long

Dim lErrCde As Long
Dim i As Integer
    
    'Stop getting status
    frmRun.tmrChkStatus.Enabled = False
    frmRun.Enabled = False
    butTerminal.Caption = "Waiting..."
    
    'Get least conversion status
    lErrCde = DRV_FAICheck(ghDev, ptAiCheck)
    If DoesErr(lErrCde) Then
        lErrCde = DRV_FAITerminate(ghDev)
        ReDim giIntBuf(0)
        DRV_DeviceClose (ghDev)
        
        frmRun.Enabled = True
        butTerminal.Caption = "&Terminal"
        frmInit.Enabled = True
        Exit Sub
    End If
    
    'Get watchdog status
    ptFAIWatchdogCheck.DataType = frmInit.chkFloatData.value
    ptFAIWatchdogCheck.ActiveBuf = DRV_GetAddress(iWhichBuf)
    ptFAIWatchdogCheck.triggered = DRV_GetAddress(iTriggered)
    ptFAIWatchdogCheck.TrigChan = DRV_GetAddress(iTrigChan)
    ptFAIWatchdogCheck.TrigIndex = DRV_GetAddress(lTrigIndex)
    If ptFAIWatchdogCheck.DataType = 1 Then
        ptFAIWatchdogCheck.TrigData = DRV_GetAddress(fTrigData)
    Else
        ptFAIWatchdogCheck.TrigData = DRV_GetAddress(iRawData)
    End If
    
    lErrCde = DRV_FAIWatchdogCheck(ghDev, ptFAIWatchdogCheck)
    If DoesErr(lErrCde) Then
        lErrCde = DRV_FAIStop(ghDev)
        ReDim giIntBuf(0)
        DRV_DeviceClose (ghDev)
        
        frmRun.Enabled = True
        butTerminal.Caption = "&Terminal"
        frmInit.Enabled = True
        Exit Sub
    End If

    'Stop Condition conversion action
    lErrCde = DRV_FAITerminate(ghDev)
    If DoesErr(lErrCde) Then
        ReDim giIntBuf(0)
        DRV_DeviceClose (ghDev)
        
        frmRun.Enabled = True
        butTerminal.Caption = "&Terminal"
        frmInit.Enabled = True
        Exit Sub
    End If
    
    'Show watchdog  status to data display form
    frmDataDisplay.lstStatus.Clear
    frmDataDisplay.lstBufferA.Clear
    frmDataDisplay.lstBufferB.Clear
    
    If (gWatchdogCfg.TrigMode <> 0) Then        'Is free Run?
        'What kind of trig mode is?
        If gWatchdogCfg.TrigMode = 1 Then        'Is PRE_TRIG?
            frmDataDisplay.lstStatus.AddItem "Acquisition mode: pre-trig"
        ElseIf gWatchdogCfg.TrigMode = 2 Then    'Is POST_TRIG?
            frmDataDisplay.lstStatus.AddItem "Acquisition mode:Acquisition mode: post-trig"
        Else                                     'Else is Position-trig
            frmDataDisplay.lstStatus.AddItem "Acquisition mode: position-trig"
        End If
       
        'IF watch dog condition does nt satisfied
        If (iTriggered <> 1) Then
            frmDataDisplay.lstStatus.AddItem "Watchdog status: failure"
        Else
            'condition satisfiled, display more information
            frmDataDisplay.lstStatus.AddItem "Watchdog status: Satisfied"

            'Which buffer?
            If (iWhichBuf = 0) Then     'Watchdog condition in buffer A
                frmDataDisplay.lstStatus.AddItem "Satisfied buffer: A"
            Else
                frmDataDisplay.lstStatus.AddItem "Satisfied buffer: B"
            End If

            'Which channel?
            frmDataDisplay.lstStatus.AddItem "Satisfied channel: " + Str(iTrigChan)

            'Which one?
            frmDataDisplay.lstStatus.AddItem "Satisfied index: " + Str(lTrigIndex)

            'What value?
            If (ptFAIWatchdogCheck.DataType = 0) Then
                'RAW data (Hex display it)
                frmDataDisplay.lstStatus.AddItem "Satisfied data: " + Hex(iRawData) + "H"
            Else
                'Floating data
                frmDataDisplay.lstStatus.AddItem "Satisfied data: " + Str(fTrigData)
            End If
        End If
    End If
    
    'Get the AI conversion data
    ptFAIData.ActiveBuf = 0                'read buffer A
    ptFAIData.Overrun = DRV_GetAddress(lOverrun)
    ptFAIData.Count = giConvCount
    ptFAIData.start = 0                    'Start from buffer begging
    ptFAIData.DataType = frmInit.chkFloatData.value

    'If want floating data
    If (ptFAIData.DataType) = 1 Then
        ReDim sDataBuffer(giConvCount) As Single
        ptFAIData.DataBuffer = DRV_GetAddress(sDataBuffer(0))
    Else
        'Else need Raw data
        ReDim iDataBuffer(giConvCount) As Integer
        ptFAIData.DataBuffer = DRV_GetAddress(iDataBuffer(0))
    End If
        
    'Read data from buffer A
    lErrCde = DRV_FAITransfer(ghDev, ptFAIData)
    If (DoesErr(lErrCde) = 1) Then
        ReDim sDataBuffer(0)
        ReDim iDataBuffer(0)
        ReDim giIntBuf(0)
        DRV_DeviceClose (ghDev)
        
        frmRun.Enabled = True
        butTerminal.Caption = "&Terminal"
        frmInit.Enabled = True
        Exit Sub
    End If

    'Save buffer A data to data show screen
    For i = 0 To ptFAIData.Count - 1
        If ptFAIData.DataType = 1 Then
            'Converting to Floating data
            frmDataDisplay.lstBufferA.AddItem Str(i) + ": " + Format(sDataBuffer(i), "###0.000000")
        Else
            'Convert to Hex data
            frmDataDisplay.lstBufferA.AddItem Str(i) + ": " + Hex(iDataBuffer(i))
        End If
    Next i

    'Read buffer B data
    ptFAIData.ActiveBuf = 1                'only one buffer
    lErrCde = DRV_FAITransfer(ghDev, ptFAIData)
    If (DoesErr(lErrCde) = 1) Then
        ReDim sDataBuffer(0)
        ReDim iDataBuffer(0)
        ReDim giIntBuf(0)
        DRV_DeviceClose (ghDev)
        
        frmRun.Enabled = True
        butTerminal.Caption = "&Terminal"
        frmInit.Enabled = True
       Exit Sub
    End If

    'Save Buffer B data to data show screen
    For i = 0 To ptFAIData.Count - 1
        If ptFAIData.DataType = 1 Then
            'Converting to Floating data
            frmDataDisplay.lstBufferB.AddItem Str(i) + ": " + Format(sDataBuffer(i), "###0.00000")
        Else
            'Convert to Hex data
            frmDataDisplay.lstBufferB.AddItem Str(i) + ": " + Hex(iDataBuffer(i))
        End If
    Next i


    'Free data buffer
    ReDim sDataBuffer(0)
    ReDim iDataBuffer(0)
    ReDim giIntBuf(0)

    'Close device
    DRV_DeviceClose (ghDev)

    'Restore frmRun labels
    frmRun.Enabled = True
    butTerminal.Caption = "&Terminal"
    frmInit.Enabled = True
    
    frmDataDisplay.Show
    frmDataDisplay.tabView.Tab = 0
End Sub


Private Sub tmrChkStatus_Timer()
Dim lErrCde As Long
    
    'Check conversion status
    lErrCde = DRV_FAICheck(ghDev, ptAiCheck)
    If DoesErr(lErrCde) = 1 Then
        tmrChkStatus.Enabled = False
        Exit Sub
    End If
    prgsConvCount.value = lRetrieved

    'Does conversion finished?
    If iStopped = 1 Then Unload frmRun
        
End Sub