frmstart.frm

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

FRM
459 行
字号 
VERSION 5.00
Begin VB.Form frmDevSel 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Alarm Demo: Select Input Device"
   ClientHeight    =   4464
   ClientLeft      =   1752
   ClientTop       =   1596
   ClientWidth     =   4236
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   7.8
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4464
   ScaleWidth      =   4236
   Begin VB.ListBox lstChannel 
      Height          =   1008
      Left            =   2400
      TabIndex        =   13
      Top             =   1800
      Width           =   1575
   End
   Begin VB.CommandButton cmdLatMode 
      Caption         =   "Latch"
      Height          =   375
      Left            =   2880
      TabIndex        =   11
      Top             =   3120
      Width           =   1095
   End
   Begin VB.TextBox txtLowAlarm 
      Height          =   375
      Left            =   1560
      TabIndex        =   8
      Top             =   3120
      Width           =   1215
   End
   Begin VB.TextBox txtHighAlarm 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   240
      TabIndex        =   7
      Top             =   3120
      Width           =   1215
   End
   Begin VB.ListBox lstModule 
      Appearance      =   0  'Flat
      Height          =   984
      Left            =   240
      TabIndex        =   4
      Top             =   1800
      Width           =   2055
   End
   Begin VB.CommandButton cmdExit 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "E&xit"
      Height          =   495
      Left            =   2520
      TabIndex        =   2
      Top             =   3840
      Width           =   1095
   End
   Begin VB.CommandButton cmdRun 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Run..."
      Height          =   495
      Left            =   480
      TabIndex        =   1
      Top             =   3840
      Width           =   1095
   End
   Begin VB.ListBox lstDevice 
      Appearance      =   0  'Flat
      Height          =   984
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   3735
   End
   Begin VB.Label labChannel 
      BackColor       =   &H80000005&
      Caption         =   "Select a channel"
      Height          =   255
      Left            =   2400
      TabIndex        =   12
      Top             =   1560
      Width           =   1575
   End
   Begin VB.Label labLatMode 
      BackColor       =   &H80000005&
      Caption         =   "latch Mode"
      Height          =   255
      Left            =   2880
      TabIndex        =   10
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label labLowAlarm 
      BackColor       =   &H80000005&
      Caption         =   "Low Alarm"
      Height          =   255
      Left            =   1560
      TabIndex        =   9
      Top             =   2880
      Width           =   975
   End
   Begin VB.Label labHighAlarm 
      BackColor       =   &H80000005&
      Caption         =   "High Alarm"
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   2880
      Width           =   975
   End
   Begin VB.Label labModule 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Select a  module"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   480
      TabIndex        =   5
      Top             =   1560
      Width           =   3375
   End
   Begin VB.Label labDevLst 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Select a device from list"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   480
      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 lpDevConfig_AI As DEVCONFIG_AI
Dim lpAIGetConfig As PT_AIGetConfig
Dim gnNumOfSubdevices As Integer
Dim bRun As Boolean



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 cmdLatMode_Click()
    If cmdLatMode.Caption = "Latch" Then
        cmdLatMode.Caption = "Momentary"
    Else
        cmdLatMode.Caption = "Latch"
    End If
End Sub

Private Sub cmdRun_Click()
  Dim tempNum As Integer
  Dim LatchMode As Integer

  AlarmChan = lstChannel.ListIndex
  ptAlarmConfig.chan = AlarmChan
  ptAlarmConfig.LoLimit = Val(txtLowAlarm.Text)
  ptAlarmConfig.HiLimit = Val(txtHighAlarm.Text)
  ErrCde = DRV_AlarmConfig(DeviceHandle, ptAlarmConfig)
  If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
  End If

  If cmdLatMode.Caption = "Latch" Then
        LatchMode = 0
  Else
        LatchMode = 1
  End If

  ptAlarmEnable.chan = AlarmChan
  ptAlarmEnable.LatchMode = LatchMode
  ptAlarmEnable.Enabled = 1         ' enable alarm
  ErrCde = DRV_AlarmEnable(DeviceHandle, ptAlarmEnable)
  If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
  End If

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

    txtHighAlarm.Text = Str(30)
    txtLowAlarm.Text = Str(10)

    labModule.Enabled = False
    lstModule.Enabled = False
    'labChannel.enabled = False
    'lstChannel.enabled = False
    'labVoltageRange.enabled = False
    'lstVoltageRange.enabled = False
    'labExpChl.enabled = False
    'lstExpChl.enabled = False
    'labThermocouple.enabled = False
    'lstThermocouple.enabled = False
    labHighAlarm.Enabled = False
    txtHighAlarm.Enabled = False
    labLowAlarm.Enabled = False
    txtLowAlarm.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
  Dim lpDevConfig_AI As DEVCONFIG_AI

  lstModule.Clear
  lstChannel.Clear
  'lstVoltageRange.Clear
  'lstExpChl.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
    'labVoltageRange.enabled = False
    'lstVoltageRange.enabled = False
    'labExpChl.enabled = False
    'lstExpChl.enabled = False
    'labThermocouple.enabled = False
    'lstThermocouple.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)
      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

      If (lpDevConfig_AI.usChanConfig = 0) Then
        tempNum = lpDevFeatures.usMaxAISiglChl
      Else
        tempNum = lpDevFeatures.usMaxAIDiffChl
      End If
      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

    If gnNumOfSubdevices <> 0 Then
        lstChannel.Clear
        '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

        If (lpDevConfig_AI.usChanConfig = 0) Then
            tempNum = lpDevFeatures.usMaxAISiglChl
        Else
            tempNum = lpDevFeatures.usMaxAIDiffChl
        End If
        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

            labHighAlarm.Enabled = True
            txtHighAlarm.Enabled = True
            labLowAlarm.Enabled = True
            txtLowAlarm.Enabled = True
            cmdRun.Enabled = True
        End If
    End If
End Sub

frmstart.frm - 源码说明

本页面展示了「16 relay output channels and 16 isolated digital input channels LED indicators to show activated」中的 frmstart.frm 源码文件，采用 FRM 编程语言编写，共 459 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与继电器输出相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

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