frmstart.frm

来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 322 行

VERSION 5.00
Begin VB.Form frmDevSel 
   Appearance      =   0  'Flat
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Analog Output Demo: Select Output Device"
   ClientHeight    =   2775
   ClientLeft      =   2460
   ClientTop       =   2520
   ClientWidth     =   5715
   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     =   2775
   ScaleWidth      =   5715
   Begin VB.ListBox lstChannel 
      Appearance      =   0  'Flat
      Height          =   810
      Left            =   4200
      TabIndex        =   6
      Top             =   480
      Width           =   1095
   End
   Begin VB.ListBox lstModule 
      Appearance      =   0  'Flat
      Height          =   810
      Left            =   240
      TabIndex        =   4
      Top             =   1680
      Width           =   3735
   End
   Begin VB.CommandButton cmdExit 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "E&xit"
      Height          =   495
      Left            =   4200
      TabIndex        =   2
      Top             =   2040
      Width           =   1095
   End
   Begin VB.CommandButton cmdRun 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Run..."
      Height          =   495
      Left            =   4200
      TabIndex        =   1
      Top             =   1440
      Width           =   1095
   End
   Begin VB.ListBox lstDevice 
      Appearance      =   0  'Flat
      Height          =   810
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   3735
   End
   Begin VB.Label labChannel 
      Appearance      =   0  'Flat
      Caption         =   "Output channel"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   4200
      TabIndex        =   7
      Top             =   240
      Width           =   1335
   End
   Begin VB.Label labModule 
      Appearance      =   0  'Flat
      Caption         =   "Select a  module"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   1440
      Width           =   3375
   End
   Begin VB.Label labDevLst 
      Appearance      =   0  'Flat
      Caption         =   "Select a device from list"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      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
Dim AOGetConfig As PT_AIGetConfig
Dim gnNumOfSubdevices As Integer
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
  End If
  End
End Sub

Private Sub cmdRun_Click()
  lpAOConfig.chan = lstChannel.ListIndex
  If (gnNumOfSubdevices = 0) Then
    lpAOConfig.MaxValue = 5
    lpAOConfig.MinValue = 0
  Else
    ' For ADAM Moduel
    lpAOConfig.MaxValue = 10
    lpAOConfig.MinValue = 0
  End If
  If (gnNumOfSubdevices = 0) Then
    ErrCde = DRV_AOConfig(DeviceHandle, lpAOConfig)
    If (ErrCde <> 0) Then
      DRV_GetErrorMessage ErrCde, szErrMsg
      Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
      Exit Sub
    End If
  End If

  frmRun.Show
  frmRun.vsclVoltage.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

  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 tempNum As Integer
  Dim TestRes As Boolean
  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)

      ' Add analog input channel item
      tempNum = lpDevFeatures.usMaxAOChl
      If (tempNum > 0) Then
        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
      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

    lstChannel.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
      tempNum = lpDevFeatures.usMaxAOChl
      If (tempNum > 0) Then
        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
      End If

      cmdRun.Enabled = True
End Sub