frmstart.frm

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

FRM
570
字号

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

  bRun = False

  ' 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

  ' Return the number of devices which you install in the system using
  ' Device Installation
  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

  labVoltageRange.Enabled = False
  lstVoltageRange.Enabled = False
    
  'labExpChl.enabled = False
  'lstExpChl.enabled = False
  'labThermocouple.enabled = False
  'lstThermocouple.enabled = False
    
  cmdRun.Enabled = False
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Unload Me
End Sub


Private Sub lstDevice_Click()
  Dim i, ii As Integer
  Dim tempNum As Integer
  Dim tempStr As String
  Dim TestRes As Boolean

  Dim nOutEntries As Integer
  Dim lpSubDeviceList As Long

  Dim iMaxSingleChannel As Integer
  Dim iMaxDiffChannel As Integer

  'Reset Gain code setting
  For i = 0 To MaxChannels
    usGainIndex(i) = 0
  Next i

  lstModule.Clear
  lstVoltageRange.Clear
  'lstExpChl.Clear
  CmbStartChan.Clear
  CmbNumChan.Clear

  ' Avoid to open Advantech Demo Card
  TestRes = TestStr(lstDevice.Text, "DEMO")
  If (TestRes) Then
    labModule.Enabled = False
    lstModule.Enabled = False
    
    labVoltageRange.Enabled = False
    lstVoltageRange.Enabled = False
    
    'labExpChl.enabled = False
    'lstExpChl.enabled = False
    'labThermocouple.enabled = False
    'lstThermocouple.enabled = False
    
    gnNumOfSubdevices = devicelist(lstDevice.ListIndex).dwDeviceNum
    If (gnNumOfSubdevices > MaxDev) Then
      gnNumOfSubdevices = MaxDev
    End If
    
    ErrCde = DRV_DeviceOpen(gnNumOfSubdevices, DeviceHandle)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
      Exit Sub
    Else
      bRun = True
      cmdRun.Enabled = True
    End If
  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!!")
        'Close device
        DRV_DeviceClose (DeviceHandle)
        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

    ' Data Acquisition & Control or Digital I/O card
    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!!")
        'Close device
        DRV_DeviceClose (DeviceHandle)
        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!!")
        'Close device
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
      End If

      ptAIGetConfig.buffer = DRV_GetAddress(lpDEVCONFIG_AI)
      ErrCde = DRV_AIGetConfig(DeviceHandle, ptAIGetConfig)
      If (ErrCde <> 0) Then
        DRV_GetErrorMessage ErrCde, szErrMsg
        Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
        'Close device
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
      End If
      
      'get the max channel number
      iMaxSingleChannel = lpDevFeatures.usMaxAISiglChl
      iMaxDiffChannel = lpDevFeatures.usMaxAIDiffChl
      
      If lpDEVCONFIG_AI.ulChanConfig = 1 Then
         tempNum = iMaxDiffChannel
      ElseIf iMaxSingleChannel > iMaxDiffChannel Then
         tempNum = iMaxSingleChannel
      Else
         tempNum = iMaxDiffChannel
      End If
      
      For i = 0 To tempNum - 1
        CmbStartChan.AddItem (Str(i))
      Next i
      CmbStartChan.ListIndex = 0
'      CmbStartChan.Text = CmbStartChan.List(0)
'      CmbStartChan_Click

      ' add gain code list
      tempNum = lpDevFeatures.usNumGain
      If (lpDevFeatures.usNumGain > 0) Then
        For i = 0 To (lpDevFeatures.usNumGain - 1)
          tempStr = ""
          For ii = 0 To 15
              tempStr = tempStr + Chr(lpDevFeatures.glGainList(i).szGainStr(ii))
          Next ii
          lstVoltageRange.AddItem tempStr
        Next i
        lstVoltageRange.Text = lstVoltageRange.List(0)
        lstVoltageRange.Enabled = True
        Call lstVoltageRange_Click
        labVoltageRange.Enabled = True
      End If

      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
    Dim tempStr As String

    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 analog input channel item
    ptAIGetConfig.buffer = DRV_GetAddress(lpDEVCONFIG_AI)
    ErrCde = DRV_AIGetConfig(DeviceHandle, ptAIGetConfig)
    If (ErrCde <> 0) Then
       DRV_GetErrorMessage ErrCde, szErrMsg
       Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
       Exit Sub
    End If

    ' add gain code list
    tempNum = lpDevFeatures.usNumGain
    If (lpDevFeatures.usNumGain > 0) Then
       For i = 0 To (lpDevFeatures.usNumGain - 1)
          tempStr = ""
          For ii = 0 To 15
             tempStr = tempStr + Chr(lpDevFeatures.glGainList(i).szGainStr(ii))
          Next ii
          lstVoltageRange.AddItem tempStr
       Next i
       lstVoltageRange.Text = lstVoltageRange.List(0)
       lstVoltageRange.Enabled = True
       labVoltageRange.Enabled = True
    End If

    cmdRun.Enabled = True
End Sub


Private Sub lstVoltageRange_Click()
Dim i As Integer
    
    For i = 0 To MaxChannels
        usGainCode(i) = lpDevFeatures.glGainList(lstVoltageRange.ListIndex).usGainCde
    Next i
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?