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         =   "Pulse Output Demo: Select Device"
   ClientHeight    =   4395
   ClientLeft      =   1245
   ClientTop       =   2355
   ClientWidth     =   4230
   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"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4395
   ScaleWidth      =   4230
   Begin VB.ListBox lstGateMode 
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   615
      Left            =   1680
      TabIndex        =   8
      Top             =   3360
      Width           =   1335
   End
   Begin VB.ListBox lstChannel 
      Appearance      =   0  'Flat
      Height          =   615
      Left            =   240
      TabIndex        =   6
      Top             =   3360
      Width           =   1335
   End
   Begin VB.ListBox lstModule 
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   810
      Left            =   240
      TabIndex        =   4
      Top             =   1920
      Width           =   3735
   End
   Begin VB.CommandButton cmdExit 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "E&xit"
      Height          =   375
      Left            =   3120
      TabIndex        =   2
      Top             =   3840
      Width           =   855
   End
   Begin VB.CommandButton cmdRun 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Run..."
      Height          =   375
      Left            =   3120
      TabIndex        =   1
      Top             =   3240
      Width           =   855
   End
   Begin VB.ListBox lstDevice 
      Appearance      =   0  'Flat
      Height          =   810
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   3735
   End
   Begin VB.Label labGateMode 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Gate Mode"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1680
      TabIndex        =   9
      Top             =   3120
      Width           =   1215
   End
   Begin VB.Label labChannel 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Channel"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   3120
      Width           =   855
   End
   Begin VB.Label labModule 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Select a  module"
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   480
      TabIndex        =   5
      Top             =   1680
      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

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()
  ptCounterPulseStart.counter = lstChannel.ListIndex
  ptCounterPulseStart.Period = 0.001                       ' Gate period
  ptCounterPulseStart.UpCycle = ptCounterPulseStart.Period / 2              '
  ptCounterPulseStart.GateMode = lstGateMode.ListIndex  ' Gate mode
  ErrCde = DRV_CounterPulseStart(DeviceHandle, ptCounterPulseStart)
  If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Sub
  End If

  frmRun.Show
  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

  ' 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

  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
  
  '*****************************
  ' 1. Action for Gate Mode List
  '*****************************
  'Add the selected Items for Gate mode
  lstGateMode.AddItem "No gating"
  lstGateMode.AddItem "Active high level"
  lstGateMode.AddItem "Active low level"
  lstGateMode.AddItem "Active high edge"
  lstGateMode.AddItem "Active low edge"

  'The default Gate mode selection
  lstGateMode.ListIndex = 0

End Sub

Private Sub lstDevice_Click()
  Dim i, ii As Integer
  Dim tempNum As Integer
  Dim TestRes As Boolean
  Dim gnNumOfSubdevices As Integer
  Dim nOutEntries As Integer
  Dim lpSubDeviceList As Long
  Dim dwDeviceNum As Long
        
  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
   
    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
    
      ' Add timer/count channel item
      lstChannel.Clear
      tempNum = lpDevFeatures.usMaxTimerChl
      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
      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
    DeviceNum = SubDevicelist(lstModule.ListIndex).dwDeviceNum
    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
    
    ' Add timer/count channel item
    lstChannel.Clear
    tempNum = lpDevFeatures.usMaxTimerChl
    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
    cmdRun.Enabled = True
End Sub