frmmain.frm

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

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Advantech Driver Demo : Pulse Width Measurement"
   ClientHeight    =   2745
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5115
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   5115
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.ComboBox cmbChl 
      Height          =   315
      Left            =   1560
      Style           =   2  'Dropdown List
      TabIndex        =   11
      Top             =   1095
      Width           =   975
   End
   Begin VB.TextBox txtCounterStatus 
      Height          =   615
      Left            =   210
      Locked          =   -1  'True
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   1560
      Width           =   4695
   End
   Begin VB.TextBox txtScan 
      Height          =   315
      Left            =   3270
      TabIndex        =   7
      Text            =   "1000"
      Top             =   1080
      Width           =   855
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "E&xit"
      Height          =   375
      Left            =   2805
      TabIndex        =   6
      Top             =   2280
      Width           =   1095
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "&Start"
      Height          =   375
      Left            =   1215
      TabIndex        =   5
      Top             =   2280
      Width           =   1095
   End
   Begin VB.Timer Timer1 
      Left            =   0
      Top             =   0
   End
   Begin VB.ComboBox cmbModule 
      Enabled         =   0   'False
      Height          =   315
      Left            =   1560
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   720
      Width           =   2655
   End
   Begin VB.ComboBox cmbSelectDevice 
      Height          =   315
      Left            =   1560
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   360
      Width           =   2655
   End
   Begin VB.Label lblms 
      Caption         =   "ms"
      Height          =   195
      Left            =   4200
      TabIndex        =   9
      Top             =   1140
      Width           =   315
   End
   Begin VB.Label lblScan 
      Alignment       =   1  'Right Justify
      Caption         =   "Scan"
      Height          =   195
      Left            =   2520
      TabIndex        =   8
      Top             =   1140
      Width           =   735
   End
   Begin VB.Label lblChannel 
      Alignment       =   1  'Right Justify
      Caption         =   "Channel"
      Height          =   195
      Left            =   480
      TabIndex        =   4
      Top             =   1140
      Width           =   1005
   End
   Begin VB.Label lblModule 
      Alignment       =   1  'Right Justify
      Caption         =   "Module"
      Height          =   195
      Left            =   120
      TabIndex        =   3
      Top             =   780
      Width           =   1365
   End
   Begin VB.Label lblSelecrDevice 
      Alignment       =   1  'Right Justify
      Caption         =   "Select Device"
      Height          =   195
      Left            =   120
      TabIndex        =   1
      Top             =   420
      Width           =   1365
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmbChl_Change()
    nChannel = cmbChl.ListIndex
End Sub

Private Sub cmbModule_Click()
    nSubDevice = cmbModule.ListIndex
End Sub

Private Sub cmbSelectDevice_Click()
    nDevice = cmbSelectDevice.ListIndex
    'sub device
    uHandleSubDevice
    'channel
    uHandleChannel
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdStart_Click()
    Static nFlag As Integer    'default value is 0
    nFlag = Abs(nFlag - 1)
    If (nFlag = 1) Then
        bRun = True
        cmdStart.Caption = "&Stop"
        cmdExit.Enabled = False
        cmbSelectDevice.Enabled = False
        If (Not uRun()) Then
            cmdStart.Caption = "&Start"
            cmdExit.Enabled = True
            cmbSelectDevice.Enabled = True
            bRun = False
            nFlag = 0
        End If
    Else
        bRun = False
        cmdStart.Caption = "&Start"
        cmdExit.Enabled = True
        Timer1.Enabled = False
        cmbSelectDevice.Enabled = True
        ErrCde = DRV_CounterReset(DeviceHandle, nChannel)
        If (ErrCde <> 0) Then
            uShowErrMsg
        End If
        ErrCde = DRV_DeviceClose(DeviceHandle)
        If (ErrCde <> 0) Then
            uShowErrMsg
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim nOutEntries As Integer
    Dim i, ii As Integer
    Dim tt As Long
    Dim tempStr As String
    
    bRun = False
    DeviceHandle = vbNull
    Timer1.Enabled = False
    
    'Add type of PC Card
    tt = DRV_GetAddress(devicelist(0))
    ErrCde = DRV_DeviceGetList(tt, MaxEntries, nOutEntries)
    If (ErrCde <> 0) Then
        uShowErrMsg
        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
        uShowErrMsg
        End
    End If
    For i = 0 To (gnNumOfDevices - 1)
        tempStr = ""
        For ii = 0 To MaxDevNameLen
            tempStr = tempStr & Chr(devicelist(i).szDeviceName(ii))
        Next ii
        cmbSelectDevice.AddItem tempStr
    Next i
    If (gnNumOfDevices > 0) Then cmbSelectDevice.ListIndex = 0
End Sub

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

Private Sub Timer1_Timer()
    ErrCde = DRV_PWMStartRead(DeviceHandle, ptPWMStartRead)
    If (ErrCde <> 0) Then
        uShowErrMsg
        Timer1.Enabled = False
        cmdStart_Click
        'bRun = False
        Exit Sub
    End If
    'show result
    txtCounterStatus.Text = "High Period =" & Format(dbHiPeriod, "###0.000000") & _
        "     Low Period =" & Format(dbLoPeriod, "###0.000000")
End Sub

Private Function uHandleSubDevice() As Boolean
    Dim tt As Long, nOutEntries As Integer
    Dim i As Integer, ii As Integer, tempStr As String * 80
    uHandleSubDevice = True
    gnNumOfSubDevices = devicelist(nDevice).nNumOfSubdevices
    If (gnNumOfSubDevices > 0) Then
        tt = DRV_GetAddress(SubDevicelist(0))
        ErrCde = DRV_DeviceGetSubList(devicelist(nDevice).dwDeviceNum, tt, gnNumOfSubDevices, nOutEntries)
        If (ErrCde <> 0) Then
            uShowErrMsg
            uHandleSubDevice = False
            Exit Function
        End If
        cmbModule.Enabled = True
        For i = 0 To gnNumOfSubDevices - 1
            tempStr = ""
            For ii = 0 To MaxDevNameLen
                tempStr = tempStr & Chr(SubDevicelist(i).szDeviceName(ii))
            Next ii
            cmbModule.AddItem tempStr
        Next i
        cmbModule.ListIndex = 0
    End If
End Function

Private Function uRun() As Boolean
    uRun = True
    'get timer interval
    If (Not IsNumeric(txtScan.Text)) Then
        MsgBox "Please input numeric for Scan time.", vbOKOnly Or vbInformation, "Error"
        uRun = False
        Exit Function
    End If
    Timer1.Interval = Val(txtScan.Text)
    'open device
    If (gnNumOfSubDevices = 0) Then
        ErrCde = DRV_DeviceOpen(devicelist(nDevice).dwDeviceNum, DeviceHandle)
    Else
        ErrCde = DRV_DeviceOpen(SubDevicelist(nDevice).dwDeviceNum, DeviceHandle)
    End If
    If (ErrCde <> 0) Then
        uShowErrMsg
        uRun = False
        Exit Function
    End If
    
    'first read once, to check error
    ptPWMStartRead.usChan = nChannel
    ptPWMStartRead.flHiperiod = DRV_GetAddress(dbHiPeriod)
    ptPWMStartRead.flLowperiod = DRV_GetAddress(dbLoPeriod)
    ErrCde = DRV_PWMStartRead(DeviceHandle, ptPWMStartRead)
    If (ErrCde <> 0) Then
        uShowErrMsg
        uRun = False
        Exit Function
    End If
    'show result
    txtCounterStatus.Text = "High Period =" & Format(dbHiPeriod, "###0.000000") & _
        "     Low Period =" & Format(dbLoPeriod, "###0.000000")
   'enable timer
    Timer1.Enabled = True
End Function

Private Function uHandleChannel() As Boolean
    Dim i As Integer
    
    uHandleChannel = True
    'open device
    If (gnNumOfSubDevices = 0) Then
        ErrCde = DRV_DeviceOpen(devicelist(nDevice).dwDeviceNum, DeviceHandle)
    Else
        ErrCde = DRV_DeviceOpen(SubDevicelist(nDevice).dwDeviceNum, DeviceHandle)
    End If
    If (ErrCde <> 0) Then
        uShowErrMsg
        uHandleChannel = False
        Exit Function
    End If
    'get number of counter channel
    ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
    ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
    If (ErrCde <> 0) Then
        uShowErrMsg
        DRV_DeviceClose DeviceHandle
        uHandleChannel = False
        Exit Function
    End If
    'counter channel
    cmbChl.Clear
    For i = 0 To lpDevFeatures.usMaxTimerChl - 1
        cmbChl.AddItem i
        i = i + 1
    Next i
    cmbChl.ListIndex = 0
    DRV_DeviceClose DeviceHandle
End Function