adint.frm

16 relay output channels and 16 isolated digital input channels LED indicators to show activated

      Exit Sub
   End If
   If (gwExtTrig = 0) Then          'if is internal trigger
      If (Not IsNumeric(Pacer.Text)) Then
         MsgBox "Please input Numeric PacerRate!", vbOKCancel Or vbInformation, "Error"
         Exit Sub
      End If
   End If
   If gwFifoEnable = 1 Then
       If IsNumeric(txtFifoSize.Text) Then
           gwFifoSize = Abs(Val(txtFifoSize.Text))
       Else
           MsgBox "Please input Numeric FifoSize!", vbOKCancel Or vbInformation, "Error"
           Exit Sub
       End If
   End If
   
   'get pace rate and conv number
   gdwPacerRate = Abs(Val(Pacer.Text))
   gulConvNum = Abs(Val(Conversion.Text))
      
    'Step 1: Device open
    ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
    If (ChkErr(ErrCde)) Then
        Exit Sub
    End If
    'Step 2: Get device features
    ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
    ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
    If (ChkErr(ErrCde)) Then
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
    End If
    'Step 3: Allocate memory for driver
     ReDim hbuf(0 To gulConvNum)
    'Step 4: Allocate memory for Voltage data or Raw data
    If (gwDataType = 1) Then
      ReDim userbuf(0 To gulConvNum)
      ptFAITransfer.DataBuffer = DRV_GetAddress(userbuf(0))
    Else
      ReDim userRawbuf(0 To gulConvNum)
      ptFAITransfer.DataBuffer = DRV_GetAddress(userRawbuf(0))
    End If
    'prepare some informations to run
    ptFAIIntStart.buffer = DRV_GetAddress(hbuf(0))
    'Step 5: Enable event feature
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT Or ADS_EVT_BUFCHANGE Or ADS_EVT_OVERRUN Or ADS_EVT_TERMINATED
    ptEnableEvent.Enabled = gwEvtFlag
    If gwFifoSize <> 0 Then
        ptEnableEvent.Count = gwFifoSize
    Else
        ptEnableEvent.Count = 1
    End If
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
    End If
    ptFAIIntStart.TrigSrc = gwExtTrig
    ptFAIIntStart.SampleRate = gdwPacerRate
    ptFAIIntStart.chan = gwStartChl
    ptFAIIntStart.gain = lpDevFeatures.glGainList(gwGainCode).usGainCde
    ptFAIIntStart.Count = gulConvNum
    ptFAIIntStart.Cyclic = gwCyclicCount
    If gwFifoEnable = 1 And gwFifoSize <> 0 Then
        ptFAIIntStart.IntrCount = gwFifoSize
    Else
        ptFAIIntStart.IntrCount = 1
    End If
    ErrCde = DRV_FAIIntStart(DeviceHandle, ptFAIIntStart)
    If (ChkErr(ErrCde)) Then
       ErrCde = DRV_DeviceClose(DeviceHandle)
       Exit Sub
    End If
    'disable controls
    cmdStop.Enabled = True
    cmdRun.Enabled = False
    cmdExit.Enabled = False
    DeviceSelect.Enabled = False
    cmbScanChl.Enabled = False
    Cyclic.Enabled = False
    Datafloat.Enabled = False
    Inprange.Enabled = False
    Internal.Enabled = False
    External.Enabled = False
    bRun = True
    
    pgbar.Max = gulConvNum
    Timer1.Interval = 50
    Timer1.Enabled = True
End Sub

Public Sub cmdStop_Click()
   Dim i As Long
   
   Timer1.Enabled = False
   'Step 1: Stop A/D conversion for high speed
   ErrCde = DRV_FAITerminate(DeviceHandle)
   If (ChkErr(ErrCde)) Then
       DRV_DeviceClose (DeviceHandle)
      Exit Sub
   End If
   'Step 2: Get real voltage of Buffer from driver memory buffer
    ptFAITransfer.Overrun = DRV_GetAddress(gwOverrun)
    ptFAITransfer.Count = gulConvNum
    ptFAITransfer.start = 0                    'Start from buffer begging
    ptFAITransfer.ActiveBuf = 0                'Single buffer
    ptFAITransfer.DataType = gwDataType
    ErrCde = DRV_FAITransfer(DeviceHandle, ptFAITransfer)
    If (ChkErr(ErrCde) = 1) Then
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
    End If
    'Step 3:Display data
    Datalist.Clear
    For i = 0 To ptFAITransfer.Count - 1
      If (gwDataType = 1) Then         'voltage data
        Datalist.AddItem "Buffer[" & i & "] = " & Format(userbuf(i), "#,##0.000000")
      Else
         Datalist.AddItem "Buffer[" & i & "] = " & Hex(userRawbuf(i))
      End If
    Next i
    'close device
    DRV_DeviceClose (DeviceHandle)
    cmdRun.Enabled = True
    cmdStop.Enabled = False
    cmdExit.Enabled = True
    DeviceSelect.Enabled = True
    cmbScanChl.Enabled = True
    Cyclic.Enabled = True
    Datafloat.Enabled = True
    Inprange.Enabled = True
    Internal.Enabled = True
    External.Enabled = True
    bRun = False
End Sub

Private Sub Cyclic_Click()
   gwCyclicCount = Cyclic.value
End Sub

Private Sub Datafloat_Click()
   gwDataType = Datafloat.value
End Sub

Private Sub Evtenable_Click()
   gwEvtFlag = Evtenable.value
End Sub

Private Sub DeviceSelect_Click()
 Dim i, ii As Integer
 Dim tt As Long
 Dim tempStr As String
 Dim Response
 Dim tempNum As Integer
 Dim lpDEVCONFIG_AI As DEVCONFIG_AI
    'Step 1: Select Device
    ErrCde = DRV_SelectDevice(Me.hWnd, False, dwDeviceNum, szbuffer)
    If (ChkErr(ErrCde)) Then
        Exit Sub
    End If
    DeviceSelect.Caption = szbuffer
        'Step 2: Open Devicev
    ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
    If (ChkErr(ErrCde)) Then
        Exit Sub
    End If
    
    'Step 3:Get device features
    ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
    ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
    If (ChkErr(ErrCde)) Then
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
    End If
     
    ' Step 4 : Initialize Input Range List Combobox with device features
    If (lpDevFeatures.usNumGain <> 0) Then
      Inprange.Enabled = True
      Inprange.Clear
        For i = 0 To lpDevFeatures.usNumGain - 1
            tempStr = ""
          For ii = 0 To 15
            tempStr = tempStr + Chr(lpDevFeatures.glGainList(i).szGainStr(ii))
          Next ii
            Inprange.AddItem tempStr
        Next i
        Inprange.ListIndex = 0
    Else
       Inprange.Enabled = False
    End If
    
    'init scan channel
    ptAIGetConfig.buffer = DRV_GetAddress(lpDEVCONFIG_AI)
    ErrCde = DRV_AIGetConfig(DeviceHandle, ptAIGetConfig)
    If (ChkErr(ErrCde) <> 0) Then
      DRV_DeviceClose DeviceHandle
      Exit Sub
    End If
    If lpDevFeatures.usMaxAISiglChl = 0 Then
      ii = lpDevFeatures.usMaxAIDiffChl
    Else
      ii = lpDevFeatures.usMaxAISiglChl
    End If
    For i = 0 To ii - 1
      cmbScanChl.AddItem i
    Next i
    cmbScanChl.ListIndex = 0
    'close device
    DRV_DeviceClose (DeviceHandle)
    cmdRun.Enabled = True
End Sub


Private Sub External_Click()
   gwExtTrig = 1
   Pacer.Enabled = False
   'Pacer.BackColor = &H8000000F
End Sub

Private Sub FifoEnable_Click()
   Dim lFifoSize As Long
   gwFifoEnable = FifoEnable.value
   If (gwFifoEnable = 1) Then
      txtFifoSize.Enabled = True
      'Step 1: Device open
      ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
      If (ChkErr(ErrCde)) Then
         Exit Sub
      End If
      'Step 2: Get FIFO size
      ErrCde = DRV_GetFIFOSize(DeviceHandle, lFifoSize)
      If (ChkErr(ErrCde)) Then
         Exit Sub
      End If
      'Step 3: Close device
      DRV_DeviceClose (DeviceHandle)
      gwFifoSize = lFifoSize / 2     ' divide by 2 for conversion from byte to word
      txtFifoSize.Text = gwFifoSize
      Conversion.Text = lFifoSize
   Else
      txtFifoSize.Enabled = False
      txtFifoSize.Text = ""
   End If
End Sub

Private Sub Form_Load()
   gwGainCode = 0
   gdwPacerRate = 1000               ' pacer rate
   gulConvNum = 1000                    ' conversion number
   gwStartChl = 0                        'scan channels
   gwDataType = 1                         ' display type : FLOAT(1)
   gwEvtFlag = 1                     ' event enable(0)
   gwFifoEnable = 0                  'Fifo disable(0)
   gwGainList = 0                   ' gain list flag
   gwExtTrig = 0                       'external or internal trigger
   gwCyclicMode = 0                   'cyclic or non-cyclic mode
   gwBufferMode = 0                  ' buffer: single or double
   gwIntrCount = 1
   gwCyclicCount = 0               'number of cyclic count
   gwActiveBuf = 0                 'return by FAICheck
   gwOverrun = 0                       'return by FAICheck, FAITransfer
   gwStopped = 0                     ' return by FAICheck
   gulRetrieved = 0                 'return by FAICheck
   gwHalfReady = 0                  'return by FAICheck
   gwFifoSize = FIFO_SIZE

End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   If (bRun) Then
      MsgBox "Can't close now!", vbOKOnly Or vbExclamation, "Error"
      Cancel = 1
      Exit Sub
   End If
End Sub

Private Sub Inprange_Click()
   gwGainCode = Inprange.ListIndex
End Sub

Private Sub Internal_Click()
   Pacer.Enabled = True
   gwExtTrig = 0
End Sub

Private Sub Timer1_Timer()
   Dim ptFAICheck As PT_FAICheck
   Dim lActBuf As Long, lHalf As Long, lOverRun As Long, iRet As Long, lstop As Long
   
   ptFAICheck.ActiveBuf = DRV_GetAddress(lActBuf)
   ptFAICheck.HalfReady = DRV_GetAddress(lHalf)
   ptFAICheck.Overrun = DRV_GetAddress(lOverRun)
   ptFAICheck.retrieved = DRV_GetAddress(iRet)
   ptFAICheck.stopped = DRV_GetAddress(lstop)
   ErrCde = DRV_FAICheck(DeviceHandle, ptFAICheck)
   If (ChkErr(ErrCde) <> 0) Then
      Exit Sub
   End If
   
   If (iRet = 0) Then
      iRet = iRet + 1
   End If
   pgbar.value = iRet
   If (iRet = gulConvNum) Then
      Timer1.Enabled = False
      cmdStop_Click
      Exit Sub
   End If
End Sub