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     =   1  'Fixed Single
   Caption         =   "PWM VB Example"
   ClientHeight    =   3780
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   5805
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3780
   ScaleWidth      =   5805
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdSet 
      Caption         =   "S&et"
      Enabled         =   0   'False
      Height          =   495
      Left            =   3840
      TabIndex        =   14
      Top             =   1800
      Width           =   1455
   End
   Begin VB.Frame frmPWMConfiguration 
      Caption         =   "PWM Configuration"
      Height          =   2415
      Left            =   120
      TabIndex        =   6
      Top             =   1080
      Width           =   3465
      Begin VB.TextBox txtOutCount 
         Enabled         =   0   'False
         Height          =   315
         Left            =   960
         TabIndex        =   17
         Text            =   "0"
         Top             =   960
         Width           =   915
      End
      Begin VB.ComboBox cmbChannel 
         Height          =   315
         ItemData        =   "frmMain.frx":0000
         Left            =   960
         List            =   "frmMain.frx":001C
         Style           =   2  'Dropdown List
         TabIndex        =   12
         Top             =   480
         Width           =   915
      End
      Begin VB.TextBox txtHiPeriod 
         Height          =   315
         Index           =   0
         Left            =   960
         TabIndex        =   10
         Text            =   "0.0005"
         Top             =   1920
         Width           =   915
      End
      Begin VB.TextBox txtPeriod 
         Height          =   315
         Index           =   0
         Left            =   960
         TabIndex        =   9
         Text            =   "0.001"
         Top             =   1440
         Width           =   915
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "OutCount:"
         Height          =   195
         Left            =   120
         TabIndex        =   16
         Top             =   960
         Width           =   720
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "(5e-8~0.82)"
         Height          =   195
         Index           =   1
         Left            =   2160
         TabIndex        =   15
         Top             =   1920
         Width           =   825
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "(1e-7~0.82)"
         Height          =   195
         Index           =   0
         Left            =   2160
         TabIndex        =   13
         Top             =   1560
         Width           =   825
      End
      Begin VB.Label Label2 
         Caption         =   "Channel"
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   480
         Width           =   735
      End
      Begin VB.Label Label3 
         Alignment       =   1  'Right Justify
         Caption         =   "Hi Period:                          S"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   1920
         Width           =   1965
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         Caption         =   "Period:                             S"
         Height          =   255
         Left            =   180
         TabIndex        =   7
         Top             =   1440
         Width           =   1905
      End
   End
   Begin VB.CommandButton cmdExit 
      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          =   495
      Left            =   3840
      TabIndex        =   5
      Top             =   3120
      Width           =   1425
   End
   Begin VB.CommandButton cmdRun 
      Caption         =   "&Run"
      Height          =   495
      Left            =   3840
      TabIndex        =   4
      Top             =   1200
      Width           =   1425
   End
   Begin VB.CommandButton cmdStop 
      Caption         =   "St&op"
      Enabled         =   0   'False
      Height          =   495
      Left            =   3840
      TabIndex        =   3
      Top             =   2400
      Width           =   1425
   End
   Begin VB.Frame Frame1 
      Caption         =   "Device Name:"
      Height          =   975
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5655
      Begin VB.CommandButton cmdSelectDevice 
         Caption         =   "Select &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          =   375
         Left            =   3840
         TabIndex        =   1
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label labDeviceName 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Device Name"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   3495
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ptDevFeatures As DEVFEATURES         ' structure for device features
Dim ptDevGetFeatures As PT_DeviceGetFeatures
Dim ptCounterPWMSetting As PT_CounterPWMSetting

Public DeviceNum As Long
Public DeviceHandle As Long
Public ErrorNum As Long
Public lBoardID As Long
Public usMaxCntNum As Integer
Public bRun As Boolean

Private Sub cmdExit_Click()
   End
End Sub

Private Sub cmdRun_Click()
   ErrorNum = DRV_DeviceOpen(DeviceNum, DeviceHandle)
   If CheckError(ErrorNum) <> 0 Then
      Exit Sub
   End If

   ptDevGetFeatures.buffer = DRV_GetAddress(ptDevFeatures)
'   ptDevGetFeatures.size = sizeof(ptDevFeatures)

   ErrorNum = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
   If CheckError(ErrorNum) <> 0 Then
      DRV_DeviceClose (DeviceHandle)
      Exit Sub
   End If

   ' check number of counter channels
   If ptDevFeatures.usMaxTimerChl = 0 Then
      MsgBox "No Counter Channel", vbInformation, "Driver Message"
      DRV_DeviceClose (DeviceHandle)
      Exit Sub
   End If
   ' Enable channel PWM
      ptCounterPWMSetting.Port = Val(cmbChannel.Text)
      ptCounterPWMSetting.Period = Val(txtPeriod(0).Text)
      ptCounterPWMSetting.HiPeriod = Val(txtHiPeriod(0).Text)
      ptCounterPWMSetting.OutCount = Val(txtOutCount.Text)
      ptCounterPWMSetting.GateMode = 0
      
      ErrorNum = DRV_CounterPWMSetting(DeviceHandle, ptCounterPWMSetting)
      If CheckError(ErrorNum) <> 0 Then
         Exit Sub
      End If
  ' StartPWM
      ErrorNum = DRV_CounterPWMEnable(DeviceHandle, Val(cmbChannel.Text))
      If CheckError(ErrorNum) <> 0 Then
         Exit Sub
      End If


   cmdRun.Enabled = False
   cmdStop.Enabled = True
   cmdExit.Enabled = False
   cmdSelectDevice.Enabled = False
   cmdSet.Enabled = True
   txtOutCount.Enabled = False
   
   bRun = True
End Sub

Private Sub cmdSelectDevice_Click()
 Dim Description As String
   Dim i As Integer
   
   Description = String(80, vbNullChar)
   ErrorNum = DRV_SelectDevice(hWnd, False, DeviceNum, Description)
   labDeviceName.Caption = Description
   
   ErrorNum = DRV_DeviceOpen(DeviceNum, DeviceHandle)
   If CheckError(ErrorNum) <> 0 Then
      Exit Sub
   End If

   ptDevGetFeatures.buffer = DRV_GetAddress(ptDevFeatures)
'   ptDevGetFeatures.size = sizeof(ptDevFeatures)

   ErrorNum = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
   If CheckError(ErrorNum) <> 0 Then
      DRV_DeviceClose (DeviceHandle)
      Exit Sub
   End If

   lBoardID = ptDevFeatures.dwBoardID
   usMaxCntNum = ptDevFeatures.usMaxTimerChl
   DRV_DeviceClose (DriverHandle)
   
   cmbChannel.Clear
   While (i < usMaxCntNum)
       cmbChannel.AddItem (Str(i))
       i = i + 1
   Wend
   cmbChannel.ListIndex = 0
End Sub

Private Sub cmdSet_Click()

      If ptCounterPWMSetting.OutCount <> 0 And bRun Then
        MsgBox "Can't change setting in noncylic mode", , "Error"
        Exit Sub
      End If

      ptCounterPWMSetting.Port = Val(cmbChannel.Text)
      ptCounterPWMSetting.Period = Val(txtPeriod(0).Text)
      ptCounterPWMSetting.HiPeriod = Val(txtHiPeriod(0).Text)
      ptCounterPWMSetting.OutCount = Val(txtOutCount.Text)
      ptCounterPWMSetting.GateMode = 0
      
      ErrorNum = DRV_CounterPWMSetting(DeviceHandle, ptCounterPWMSetting)
      If CheckError(ErrorNum) <> 0 Then
         Exit Sub
      End If
End Sub

Private Sub cmdStop_Click()
   frmPWMConfiguration.Enabled = True
   ' Stop ChannelPWM
   ErrorNum = DRV_CounterReset(DeviceHandle, Val(cmbChannel.Text))
     
   DRV_DeviceClose DeviceHandle

   cmdRun.Enabled = True
   cmdExit.Enabled = True
   cmdStop.Enabled = False
   cmdSelectDevice.Enabled = True
   cmdSet.Enabled = False
   txtOutCount.Enabled = True
   bRun = False
End Sub


Private Sub Form_Load()
   bRun = False
   Call cmdSelectDevice_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
   If bRun = True Then
      Call cmdStop_Click
   End If
End Sub

Public Function CheckError(ByVal lErrCde As Long) As Boolean
   Dim szErrMsg As String * 80

   If (lErrCde <> 0) Then
      DRV_GetErrorMessage lErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
      CheckError = True
   Else
      CheckError = False
   End If
End Function