adint1.frm

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

         Left            =   120
         TabIndex        =   8
         Top             =   840
         Width           =   1695
      End
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "E&xit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   7680
      TabIndex        =   3
      Top             =   3360
      Width           =   1095
   End
   Begin VB.CommandButton ComConvert 
      Caption         =   "&Convert"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6240
      TabIndex        =   2
      Top             =   3360
      Width           =   1095
   End
   Begin VB.ListBox ListDevice 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1020
      Left            =   120
      TabIndex        =   1
      Top             =   240
      Width           =   3015
   End
   Begin VB.Label Label2 
      Caption         =   "Device:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   0
      Width           =   1095
   End
End
Attribute VB_Name = "frmSelDev"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub ChkGainCde_Click()

    ErrCde = GainCodeFilling()
    If (ChkGainCde) Then
        ComGainList.Enabled = False
        ListGain.Enabled = True
    Else
        ComGainList.Enabled = True
        ListGain.Enabled = False
    End If
    
End Sub


Private Sub CombChCount_Click()
'    ErrCde = GainCodeFilling()
End Sub

Private Sub CombChCount_GotFocus()
frmSelDev.Refresh
End Sub


Private Sub CombChCount_LostFocus()
frmSelDev.Refresh
End Sub


Private Sub CombStartCh_Click()
Dim tempNum As Integer
Dim i As Integer
    
    ' Add analog input channel count item
    CombChCount.Clear
    
    For i = 1 To gwMaxLogChanNum
        CombChCount.AddItem Str(i)
    Next i
    If CombChCount.ListCount > 0 Then
        CombChCount = CombChCount.List(0)
     End If
End Sub



Private Sub ComConvert_Click()
Dim ptEnableEvent As PT_EnableEvent
Dim i As Integer, j As Integer
Dim DataSize As Long

   'check parameter
   If (Not IsNumeric(DataCounts.Text)) Then
      MsgBox "Please input Numeric Conv.#!", vbOKOnly Or vbInformation, "Error"
      Exit Sub
   End If
   If (TrigMode(0).value) Then          'if is internal trigger
      If (Not IsNumeric(SpeedRate.Text)) Then
         MsgBox "Please input Numeric PacerRate!", vbOKCancel Or vbInformation, "Error"
         Exit Sub
      End If
   End If
   If gwFifoEnable = 1 Then
       If IsNumeric(EditFIFO.Text) Then
           gwFifoSize = Abs(Val(EditFIFO.Text))
       Else
           MsgBox "Please input Numeric FifoSize!", vbOKCancel Or vbInformation, "Error"
           Exit Sub
       End If
   End If
   
    '1. Open device
    ErrCde = DRV_DeviceOpen(devicelist(ListDevice.ListIndex).dwDeviceNum, DeviceHandle)
    If (ChkErr(ErrCde)) Then
       Exit Sub
    End If
    
     ptAIGetConfig.buffer = DRV_GetAddress(lpDEVCONFIG_AI)
     ErrCde = DRV_AIGetConfig(DeviceHandle, ptAIGetConfig)
     If (ChkErr(ErrCde)) Then
         DRV_DeviceClose (DeviceHandle)
         Exit Sub
     End If
     
  
    j = PhyChanToLogChan(lpDEVCONFIG_AI, Val(CombStartCh.Text))
    For i = 0 To Val(CombChCount.Text) - 1
        wGainCode(i) = lpDevFeatures.glGainList(iGainIndex(j Mod gwMaxLogChanNum)).usGainCde
        j = j + 1
    Next i
    
    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

    '3. Start AI interrupt funciton
    '3.1 Fill element of PT_FAIIntScanStart
    ptAiStart.TrigSrc = TrigMode(1).value                'Ext trig mode
    ptAiStart.SampleRate = Abs(Val(SpeedRate.Text))
    ptAiStart.NumChans = Val(CombChCount.Text)
    ptAiStart.StartChan = Val(CombStartCh.Text)
    ptAiStart.GainList = DRV_GetAddress(wGainCode(0))
    ptAiStart.Count = Abs(Val(DataCounts.Text))
    ptAiStart.cyclic = chkCyclic.value
    If (gwFifoEnable = 1 And gwFifoSize <> 0) Then
        ptAiStart.IntrCount = gwFifoSize
    Else
        ptAiStart.IntrCount = 1
    End If
    ReDim lBuffer(Val(DataCounts.Text))       'Allocate memory
    ptAiStart.buffer = DRV_GetAddress(lBuffer(0))

    '3.2 Call advantech API function DRV_FAIIntScanStart
    ErrCde = DRV_FAIIntScanStart(DeviceHandle, ptAiStart)
    If (ChkErr(ErrCde)) Then
       ErrCde = DRV_DeviceClose(DeviceHandle)
       Exit Sub
    End If
    
    '4. Entering converting form
    frmRun.Show
    frmSelDev.Hide
    
End Sub

Private Sub ComGainList_Click()
    frmGainCdeSet.Show
End Sub


Private Sub Command2_Click()
End
End Sub

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

Private Sub FifoEnable_Click()
   Dim lFifoSize As Long
   
   gwFifoEnable = FifoEnable.value
   If (gwFifoEnable = 1) Then
      EditFIFO.Enabled = True
      
      'Step 1: Device open
      ErrCde = DRV_DeviceOpen(devicelist(ListDevice.ListIndex).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
      EditFIFO.Text = gwFifoSize
   Else
      EditFIFO.Enabled = False
      EditFIFO.Text = ""
   End If
End Sub

Private Sub Form_Load()
 Dim gnNumOfDevices As Integer
 Dim MaxEntries As Integer
 Dim nOutEntries As Integer
 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
 
 
  MaxEntries = 100
 
  ' Add type of PC Laboratory Card
  tt = DRV_GetAddress(devicelist(0))
  ErrCde = DRV_DeviceGetList(tt, MaxEntries, nOutEntries)
  If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
  End If
  
  ' Return the number of devices which you install in the system using
  ' Device Installation
  ErrCde = DRV_DeviceGetNumOfList(gnNumOfDevices)
  If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
  End If
    
  For i = 0 To (gnNumOfDevices - 1)
    tempStr = ""
    For ii = 0 To MaxDevNameLen
      tempStr = tempStr + Chr(devicelist(i).szDeviceName(ii))
    Next ii
      ListDevice.AddItem tempStr
  Next i
  ListDevice.Text = ListDevice.List(0)
  ListDevice.Enabled = True
  
  gwEvtFlag = 1                     ' event enable(0)
  gwFifoEnable = 0                  'Fifo disable(0)
  gwFifoSize = FIFO_SIZE
         
End Sub

Private Sub ListDevice_Click()
  Dim i, ii As Integer
  Dim tempNum As Integer
  Dim TestRes As Boolean
  Dim tempStr As String
  Dim nOutEntries As Integer
  Dim lpSubDeviceList As Long
  'Dim dwDeviceNum As Long
  Dim temp As String
  
     'Reset Gain code setting
     For i = 0 To MaxChannels
       iGainIndex(i) = 0
     Next i
     
     'Clear gain code selection items
     ListGain.Clear
     dwDeviceNum = devicelist(ListDevice.ListIndex).dwDeviceNum
     
     'Open selected device for getting more informations
     ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
     If (ChkErr(ErrCde)) Then
        Exit Sub
     End If
     
     'Device's informations is stored as Features and configurations
     ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
     ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
     If (ChkErr(ErrCde)) Then
         DRV_DeviceClose (DeviceHandle)
         Exit Sub
     End If
      
     ptAIGetConfig.buffer = DRV_GetAddress(lpDEVCONFIG_AI)
     ErrCde = DRV_AIGetConfig(DeviceHandle, ptAIGetConfig)
     If (ChkErr(ErrCde)) Then
         DRV_DeviceClose (DeviceHandle)
         Exit Sub
     End If
     
     'Add Gain code selection list's items
     tempNum = lpDevFeatures.usNumGain
     If (lpDevFeatures.usNumGain > 0) Then
        For i = 0 To (lpDevFeatures.usNumGain - 1)
          tempStr = ""
          For ii = 0 To 15
              tempStr = tempStr + Chr(lpDevFeatures.glGainList(i).szGainStr(ii))
          Next ii
          ListGain.AddItem tempStr
        Next i
     End If
     ListGain.Text = ListGain.List(0)
     
     ' Add analog input start channel items
     CombStartCh.Clear
     ptAIGetConfig.buffer = DRV_GetAddress(lpDEVCONFIG_AI)
     ErrCde = DRV_AIGetConfig(DeviceHandle, ptAIGetConfig)
     If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Sub
     End If
     
     
     'Add slection items of convertion channel counts
     
     If (lpDEVCONFIG_AI.ulChanConfig = 1) Then
        tempNum = lpDevFeatures.usMaxAIDiffChl
     ElseIf (lpDevFeatures.usMaxAISiglChl > lpDevFeatures.usMaxAIDiffChl) Then
        tempNum = lpDevFeatures.usMaxAISiglChl
     Else
        tempNum = lpDevFeatures.usMaxAIDiffChl
     End If
     
     If (tempNum > 0) Then
         For i = 0 To (tempNum - 1)
             temp = Str(i)
             CombStartCh.AddItem temp
         Next i
         CombStartCh.Text = CombStartCh.List(0)
         CombStartCh.Enabled = True
     End If
     
     gwMaxLogChanNum = GetMaxLogChanNum(lpDEVCONFIG_AI, lpDevFeatures)
     
     Call CombStartCh_Click
     'Close device
     DRV_DeviceClose (DeviceHandle)
      
End Sub

Private Sub ListGain_Click()
    ErrCde = GainCodeFilling()
End Sub