frmstart.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmDevSel 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Frequency  Demo: Select Device"
   ClientHeight    =   5460
   ClientLeft      =   4110
   ClientTop       =   1485
   ClientWidth     =   4215
   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     =   5460
   ScaleWidth      =   4215
   Begin VB.TextBox Text1 
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      Height          =   1455
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   12
      Text            =   "FRMSTART.frx":0000
      Top             =   3720
      Width           =   3735
   End
   Begin VB.TextBox txtGP 
      Height          =   375
      Left            =   480
      TabIndex        =   9
      Text            =   "0"
      Top             =   3000
      Width           =   975
   End
   Begin MSComCtl2.UpDown UpDown1 
      Height          =   375
      Left            =   240
      TabIndex        =   8
      Top             =   3000
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   661
      _Version        =   393216
      Alignment       =   0
      BuddyControl    =   "txtGP"
      BuddyDispid     =   196609
      OrigLeft        =   1560
      OrigTop         =   3120
      OrigRight       =   1800
      OrigBottom      =   3495
      Max             =   2000
      SyncBuddy       =   -1  'True
      BuddyProperty   =   0
      Enabled         =   -1  'True
   End
   Begin VB.ListBox lstChannel 
      Appearance      =   0  'Flat
      Height          =   810
      Left            =   2400
      TabIndex        =   6
      Top             =   1680
      Width           =   1455
   End
   Begin VB.ListBox lstModule 
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   810
      Left            =   240
      TabIndex        =   4
      Top             =   1680
      Width           =   1815
   End
   Begin VB.CommandButton cmdExit 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "E&xit"
      Height          =   375
      Left            =   3240
      TabIndex        =   2
      Top             =   3120
      Width           =   855
   End
   Begin VB.CommandButton cmdRun 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Run..."
      Height          =   375
      Left            =   2160
      TabIndex        =   1
      Top             =   3120
      Width           =   855
   End
   Begin VB.ListBox lstDevice 
      Appearance      =   0  'Flat
      Height          =   810
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   3735
   End
   Begin VB.Label Label2 
      BackColor       =   &H80000005&
      Caption         =   "ms"
      Height          =   375
      Left            =   1560
      TabIndex        =   11
      Top             =   3000
      Width           =   375
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Gate Period"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Label labChannel 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Channel"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   2400
      TabIndex        =   7
      Top             =   1440
      Width           =   855
   End
   Begin VB.Label labModule 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Select a  module"
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   1440
      Width           =   1815
   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
    DeviceHandle = 0
  End If
  Unload Me
End Sub

Private Sub cmdRun_Click()
  Dim Response As Long
  
  lpCounterFreqStart.counter = lstChannel.ListIndex * 2
  lpCounterFreqStart.GatePeriod = Val(txtGP.Text)
  lpCounterFreqStart.GateMode = 0 'No use here
  
  ErrCde = DRV_CounterFreqStart(DeviceHandle, lpCounterFreqStart)
  If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        Exit Sub
  End If
  
  frmRun.Show
  frmDevSel.Hide
  frmRun.tmrRead.Enabled = True
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
    cmdRun.Enabled = False

End Sub

Private Sub lstDevice_Click()
  Dim i, ii As Integer
  Dim j 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

  ' 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
    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
      i = 0
      j = 0
      While i < tempNum
        temp$ = "Chan#" + Str(i)
        lstChannel.AddItem temp$, j
        j = j + 1
        i = i + 2
      Wend

      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
    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 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


Private Sub VScroll1_Change()

End Sub