frmmain.frm

来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 627 行 · 第 1/2 页

         EndProperty
         Height          =   375
         Left            =   5685
         TabIndex        =   1
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label labDeviceName 
         BorderStyle     =   1  'Fixed Single
         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            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   5295
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public DeviceNum As Long
Public DeviceHandle As Long
Public ErrorNum As Long

Dim bRun As Boolean
Dim MaxAOChannel As Integer
Dim AsyncEnableCh As Integer
Dim OutputValue(0 To 3) As Single
Dim OutputIndex As Integer
Dim i As Integer

Dim ptDevFeatures As DEVFEATURES         ' structure for device features
Dim ptDevGetFeatures As PT_DeviceGetFeatures
Dim ptAOVoltageOut As PT_AOVoltageOut
Dim ptAOCurrentOut As PT_AOCurrentOut

Private Sub btnSelectDevice_Click()
   Dim i As Integer
   Dim Description As String

   Description = String(80, vbNullChar)
   ErrorNum = DRV_SelectDevice(hWnd, False, DeviceNum, Description)
   labDeviceName.Caption = Description
   ' Open device to get feature
   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

   MaxAOChannel = ptDevFeatures.usMaxAOChl

   DRV_DeviceClose (DeviceHandle)
   
   If chkSyncAOEnable.value = Checked Then
      For i = 0 To 7
         optAsyncEnable(i).Enabled = False
      Next i
      For i = 0 To 7
         If i < MaxAOChannel Then
            chkSyncEnable(i).Enabled = True
         Else
            chkSyncEnable(i).Enabled = False
         End If
      Next i
   Else
      For i = 0 To 7
         chkSyncEnable(i).Enabled = False
      Next i
      For i = 0 To 7
         If i < MaxAOChannel Then
            optAsyncEnable(i).Enabled = True
         Else
            optAsyncEnable(i).Enabled = False
         End If
      Next i
   End If
End Sub


Private Sub chkSyncAOEnable_Click()
   If chkSyncAOEnable.value = Checked Then
      For i = 0 To 7
         optAsyncEnable(i).Enabled = False
      Next i
      For i = 0 To 7
         If i < MaxAOChannel Then
            chkSyncEnable(i).Enabled = True
         Else
            chkSyncEnable(i).Enabled = False
         End If
      Next i
   Else
      For i = 0 To 7
         chkSyncEnable(i).Enabled = False
      Next i
      For i = 0 To 7
         If i < MaxAOChannel Then
            optAsyncEnable(i).Enabled = True
         Else
            optAsyncEnable(i).Enabled = False
         End If
      Next i
   End If
End Sub


Private Sub cmdExit_Click()
   End
End Sub


Private Sub cmdRun_Click()
   Dim ptDevGetPar As PT_DeviceGetParam
   Dim aosetting() As AOSET ' Dim aosetting(0 To 15) As AOSET
   Dim extra As Integer ' if you don't define this extra data, you must declare aosetting statically
   Dim size As Integer
   Dim errmsg1720 As String
   Dim errtitle1720 As String
   
   errmsg1720 = "for PCI-1720, the precondition of current out is that voltage range is set to 0 ~ 5V"
   
   If optVoltageOut.value = True Then
      OutputValue(0) = 0#
      OutputValue(1) = 1.25
      OutputValue(2) = 2.5
      OutputValue(3) = 5#
   End If
   If optCurrentOut0.value = True Then
      OutputValue(0) = 1#
      OutputValue(1) = 5#
      OutputValue(2) = 10#
      OutputValue(3) = 20#
   End If
   If optCurrentOut4.value = True Then
      OutputValue(0) = 4#
      OutputValue(1) = 10#
      OutputValue(2) = 15#
      OutputValue(3) = 20#
   End If
   
   ' Opne device
   ErrorNum = DRV_DeviceOpen(DeviceNum, DeviceHandle)
   If CheckError(ErrorNum) <> 0 Then
      Exit Sub
   End If
   
   ' for PCI-1720, the precondition of current out is voltage range is set to 0 ~ 5V
   If (optVoltageOut.value <> True) And (InStr(labDeviceName.Caption, "PCI-1720") <> 0) Then
      ' get device AO settings
      ptDevGetPar.nID = AO_RANGE_SETTING
      ReDim aosetting(0 To MaxAOChannel - 1)
      ptDevGetPar.pData = DRV_GetAddress(aosetting(0))
      ptDevGetPar.Length = DRV_GetAddress(size)
      ErrNum = DRV_DeviceGetParam(DeviceHandle, ptDevGetPar)
      If ErrNum <> 0 Then
         DRV_DeviceClose (DeviceHandle)
         Exit Sub
      End If
      
      ' check device AO settings
      If chkSyncAOEnable.value = Checked Then
         For i = 0 To MaxAOChannel - 1
            If (chkSyncEnable(i).value = Checked) And ((aosetting(i).fAOMaxVol <> 5) Or (aosetting(i).fAOMinVol <> 0)) Then
               DRV_DeviceClose (DeviceHandle)
               errtitle1720 = "Error: Channel " + Str(i)
               Response = MsgBox(errmsg1720, vbOKOnly, errtitle1720)
               Exit Sub
            End If
         Next i
      Else
         For i = 0 To MaxAOChannel - 1
            If (optAsyncEnable(i).value = True) And ((aosetting(i).fAOMaxVol <> 5) Or (aosetting(i).fAOMinVol <> 0)) Then
               DRV_DeviceClose (DeviceHandle)
               errtitle1720 = "Error: Channel " + Str(i)
               Response = MsgBox(errmsg1720, vbOKOnly, errtitle1720)
               Exit Sub
            End If
         Next i
      End If
   End If
   
   ' Enable Sync. output feature
   If chkSyncAOEnable.value = Checked Then
      ErrorNum = DRV_EnableSyncAO(DeviceHandle, True)
   Else
      ErrorNum = DRV_EnableSyncAO(DeviceHandle, False)
   End If
   If CheckError(ErrorNum) <> 0 Then
      DRV_DeviceClose (DeviceHandle)
      Exit Sub
   End If

   OutputIndex = 0

   ScanTimer.Enabled = True

   cmdRun.Enabled = False
   cmdStop.Enabled = True
   cmdExit.Enabled = False
End Sub


Private Sub cmdStop_Click()
   ScanTimer.Enabled = False
   ' Close device
   DRV_DeviceClose DeviceHandle

   cmdRun.Enabled = True
   cmdStop.Enabled = False
   cmdExit.Enabled = True
End Sub


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


Private Sub optAsyncEnable_Click(Index As Integer)
   AsyncEnableCh = Index
End Sub


Private Sub ScanTimer_Timer()
   If chkSyncAOEnable.value = Checked Then
      For i = 0 To MaxAOChannel - 1
         If chkSyncEnable(i).value = Checked Then
            If optVoltageOut.value = True Then
               ptAOVoltageOut.chan = i
               ptAOVoltageOut.OutputValue = OutputValue(OutputIndex)
               ErrorNum = DRV_AOVoltageOut(DeviceHandle, ptAOVoltageOut)
            Else
               ptAOCurrentOut.chan = i
               ptAOCurrentOut.OutputValue = OutputValue(OutputIndex)
               ErrorNum = DRV_AOCurrentOut(DeviceHandle, ptAOCurrentOut)
            End If
            If CheckError(ErrorNum) <> 0 Then
               cmdStop_Click
               Exit Sub
            End If
         End If
      Next i
      ErrorNum = DRV_WriteSyncAO(DeviceHandle)
      If CheckError(ErrorNum) <> 0 Then
         cmdStop_Click
         Exit Sub
      End If
   Else
      For i = 0 To MaxAOChannel - 1
         If optAsyncEnable(i).value = True Then
            If optVoltageOut.value = True Then
               ptAOVoltageOut.chan = i
               ptAOVoltageOut.OutputValue = OutputValue(OutputIndex)
               ErrorNum = DRV_AOVoltageOut(DeviceHandle, ptAOVoltageOut)
            Else
               ptAOCurrentOut.chan = i
               ptAOCurrentOut.OutputValue = OutputValue(OutputIndex)
               ErrorNum = DRV_AOCurrentOut(DeviceHandle, ptAOCurrentOut)
            End If
            If CheckError(ErrorNum) <> 0 Then
               cmdStop_Click
               Exit Sub
            End If
         End If
      Next i
   End If
   TxtOutput.Text = OutputValue(OutputIndex)
   OutputIndex = OutputIndex + 1
   If OutputIndex > 3 Then
      OutputIndex = 0
   End If
End Sub


Private Sub txtScanTime_Change()
   ScanTimer.Interval = Val(txtScanTime.Text)
End Sub


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

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