frmstart.frm

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

VERSION 5.00
Begin VB.Form frmDevSel 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Analog Input Demo: Select Input Device"
   ClientHeight    =   4155
   ClientLeft      =   2190
   ClientTop       =   2160
   ClientWidth     =   5505
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4155
   ScaleWidth      =   5505
   Begin VB.ListBox lstVoltageRange 
      Appearance      =   0  'Flat
      Height          =   1005
      Left            =   1800
      TabIndex        =   9
      Top             =   3000
      Width           =   2175
   End
   Begin VB.ListBox lstChannel 
      Appearance      =   0  'Flat
      Height          =   1005
      Left            =   240
      TabIndex        =   6
      Top             =   3000
      Width           =   1335
   End
   Begin VB.ListBox lstModule 
      Appearance      =   0  'Flat
      Height          =   810
      Left            =   240
      TabIndex        =   4
      Top             =   1800
      Width           =   3735
   End
   Begin VB.CommandButton cmdExit 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "E&xit"
      Height          =   495
      Left            =   4200
      TabIndex        =   2
      Top             =   1440
      Width           =   1095
   End
   Begin VB.CommandButton cmdRun 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Run..."
      Height          =   495
      Left            =   4200
      TabIndex        =   1
      Top             =   600
      Width           =   1095
   End
   Begin VB.ListBox lstDevice 
      Appearance      =   0  'Flat
      Height          =   1005
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   3735
   End
   Begin VB.Label labVoltageRange 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Voltage Range"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1800
      TabIndex        =   8
      Top             =   2760
      Width           =   1455
   End
   Begin VB.Label labChannel 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Input channel"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   2760
      Width           =   1215
   End
   Begin VB.Label labModule 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Select a  module"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   360
      TabIndex        =   5
      Top             =   1560
      Width           =   3375
   End
   Begin VB.Label labDevLst 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Select a device from list"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   480
      TabIndex        =   3
      Top             =   240
      Width           =   3375
   End
End
Attribute VB_Name = "frmDevSel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim lpDEVCONFIG_AI As DEVCONFIG_AI
Dim lpAIGetConfig As PT_AIGetConfig
Dim gnNumOfSubdevices As Integer
Dim bRun As Boolean



Function TestStr(DStr As String, TStr As String) As Boolean
  Dim lenD, lenT As Integer
  Dim i As Integer

  TestStr = False
  lenD = Len(DStr)
  lenT = Len(TStr)

  For i = 1 To (lenD - lenT + 1)
    If (Mid(DStr, i, lenT) = TStr) Then
      TestStr = True
    End If
  Next i

  If DStr = "" Then
    TestStr = True
  End If
End Function
Private Sub cmdExit_Click()
  If bRun Then
    ErrCde = DRV_DeviceClose(DeviceHandle)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    End If
  End If
  End
End Sub

Private Sub cmdRun_Click()
  Dim tempNum As Integer

  tempNum = lstVoltageRange.ListIndex
  AiCtrMode = lpDEVCONFIG_AI.usGainCtrMode
  lpAIConfig.DasChan = lstChannel.ListIndex
  ' Gain code no use for ADAM series
  If gnNumOfSubdevices = 0 Then
        lpAIConfig.DasGain = lpDevFeatures.glGainList(tempNum).usGainCde
  End If
  ErrCde = DRV_AIConfig(DeviceHandle, lpAIConfig)
  If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
  End If

  frmRun.Show
  frmRun.cmdRead.SetFocus
  frmDevSel.Hide
End Sub

Private Sub Form_Load()
  Dim gnNumOfDevices As Integer
  Dim nOutEntries As Integer
  Dim i, ii As Integer
  Dim tt As Long
  Dim tempStr As String

  bRun = False

  ' 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
      lstDevice.AddItem tempStr
  Next i

    labModule.Enabled = False
    lstModule.Enabled = False
    labChannel.Enabled = False
    lstChannel.Enabled = False
    labVoltageRange.Enabled = False
    lstVoltageRange.Enabled = False
    'labExpChl.enabled = False
    'lstExpChl.enabled = False
    'labThermocouple.enabled = False
    'lstThermocouple.enabled = False
    cmdRun.Enabled = False
End Sub


Private Sub lstDevice_Click()
  Dim i, ii As Integer
  Dim tempNum As Integer
  Dim TestRes As Boolean

  Dim nOutEntries As Integer
  Dim lpSubDeviceList As Long
  Dim dwDeviceNum As Long
'  Dim lpDEVCONFIG_AI As DEVCONFIG_AI
  
  Dim iMaxSingleChannel As Integer
  Dim iMaxDiffChannel As Integer
  
  
  lstModule.Clear
  lstChannel.Clear
  lstVoltageRange.Clear
  'lstExpChl.Clear

  ' Avoid to open Advantech Demo Card
  TestRes = TestStr(lstDevice.Text, "DEMO")
  If (TestRes) Then
    labModule.Enabled = False
    lstModule.Enabled = False
    labChannel.Enabled = False
    lstChannel.Enabled = False
    labVoltageRange.Enabled = False
    lstVoltageRange.Enabled = False
    'labExpChl.enabled = False
    'lstExpChl.enabled = False
    'labThermocouple.enabled = False
    'lstThermocouple.enabled = False
    lstChannel.AddItem "No Use"
    cmdRun.Enabled = False
  End If

  If (Not TestRes) Then
  ' Check if there is any device attatched on this COM port or CAN
    gnNumOfSubdevices = devicelist(lstDevice.ListIndex).nNumOfSubdevices
    If (gnNumOfSubdevices > MaxDev) Then
      gnNumOfSubdevices = MaxDev
    End If

    ' retrieve the information of all installed devices
    If (gnNumOfSubdevices <> 0) Then
      dwDeviceNum = devicelist(lstDevice.ListIndex).dwDeviceNum
      lpSubDeviceList = DRV_GetAddress(SubDevicelist(0))
      ErrCde = DRV_DeviceGetSubList(dwDeviceNum, lpSubDeviceList, gnNumOfSubdevices, nOutEntries)
      If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Sub
      End If
      For i = 0 To (gnNumOfSubdevices - 1)
        tempStr = ""
        For ii = 0 To MaxDevNameLen
            tempStr = tempStr + Chr(SubDevicelist(i).szDeviceName(ii))
        Next ii
        lstModule.AddItem tempStr
      Next i
      lstModule.Enabled = True
      labModule.Enabled = True
   End If

   ' Data Acquisition & Control or Digital I/O card
   If (gnNumOfSubdevices = 0) Then
     dwDeviceNum = devicelist(lstDevice.ListIndex).dwDeviceNum
      ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
      If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Sub
      Else
        bRun = True
      End If

      ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
      ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
      If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Sub
      End If

      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
     AiCtrMode = lpDEVCONFIG_AI.usGainCtrMode
     Dim BoardID As Integer
     BoardID = lpDEVCONFIG_AI.dwBoardID
     
      'get the max channel number
      'tempNum = lpDevFeatures.usMaxAISiglChl
      iMaxSingleChannel = lpDevFeatures.usMaxAISiglChl
      iMaxDiffChannel = lpDevFeatures.usMaxAIDiffChl
      
      If iMaxSingleChannel > iMaxDiffChannel Then
         tempNum = iMaxSingleChannel
      Else
         tempNum = iMaxDiffChannel
      End If
      
      If (tempNum > 0) Then
        For i = 0 To (tempNum - 1)
          temp$ = "Chan#" + Str(i)
          lstChannel.AddItem temp$, i
        Next i
        lstChannel.Text = lstChannel.List(0)
        labChannel.Enabled = True
        lstChannel.Enabled = True
      End If

      ' add gain code list
      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
          lstVoltageRange.AddItem tempStr
        Next i
        lstVoltageRange.Text = lstVoltageRange.List(0)
        lstVoltageRange.Enabled = True
        labVoltageRange.Enabled = True
      End If

      cmdRun.Enabled = True
    End If
  End If
End Sub


Private Sub lstModule_Click()
    Dim i, ii As Integer
    Dim dwDeviceNum As Long
    Dim tempNum As Integer

    lstChannel.Clear
    lstVoltageRange.Clear
    ' open COM device or CAN device
    dwDeviceNum = SubDevicelist(lstModule.ListIndex).dwDeviceNum
    ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
       Exit Sub
    Else
       bRun = True
    End If

    ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
    ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
       Exit Sub
    End If

    ' Add analog input channel item
      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

        tempNum = lpDevFeatures.usMaxAISiglChl
      If (tempNum > 0) Then
        For i = 0 To (tempNum - 1)
          temp$ = "Chan#" + Str(i)
          lstChannel.AddItem temp$, i
        Next i
        lstChannel.Text = lstChannel.List(0)
        labChannel.Enabled = True
        lstChannel.Enabled = True
      End If

      ' add gain code list
      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
          lstVoltageRange.AddItem tempStr
        Next i
        lstVoltageRange.Text = lstVoltageRange.List(0)
        lstVoltageRange.Enabled = True
        labVoltageRange.Enabled = True
      End If

      cmdRun.Enabled = True
End Sub