⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fout.frm

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 FRM
字号:
VERSION 5.00
Begin VB.Form formFout 
   Caption         =   "Fout"
   ClientHeight    =   3105
   ClientLeft      =   5640
   ClientTop       =   4950
   ClientWidth     =   6015
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3105
   ScaleWidth      =   6015
   Begin VB.CommandButton btnExit 
      Caption         =   "Exit"
      Height          =   435
      Left            =   4680
      TabIndex        =   8
      Top             =   2280
      Width           =   1095
   End
   Begin VB.CommandButton btnStop 
      Caption         =   "Stop"
      Height          =   435
      Left            =   2520
      TabIndex        =   7
      Top             =   2280
      Width           =   1095
   End
   Begin VB.CommandButton btnStart 
      Caption         =   "Start"
      Height          =   435
      Left            =   480
      TabIndex        =   6
      Top             =   2280
      Width           =   1095
   End
   Begin VB.Frame frmDivider 
      Caption         =   "Divider(2~65535)"
      Height          =   855
      Left            =   4200
      TabIndex        =   5
      Top             =   1200
      Width           =   1455
      Begin VB.TextBox txtDivider 
         Height          =   285
         Left            =   240
         TabIndex        =   11
         Text            =   "2"
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.Frame frmFoutSrc 
      Caption         =   "FoutSrc"
      Height          =   855
      Left            =   2160
      TabIndex        =   4
      Top             =   1200
      Width           =   1695
      Begin VB.ComboBox cmbFoutSrc 
         Height          =   315
         ItemData        =   "Fout.frx":0000
         Left            =   240
         List            =   "Fout.frx":0016
         TabIndex        =   10
         Top             =   360
         Width           =   1335
      End
   End
   Begin VB.Frame frmChannel 
      Caption         =   "Channel"
      Height          =   855
      Left            =   360
      TabIndex        =   3
      Top             =   1200
      Width           =   1335
      Begin VB.ComboBox cmbChannel 
         Height          =   315
         ItemData        =   "Fout.frx":004C
         Left            =   120
         List            =   "Fout.frx":005C
         TabIndex        =   9
         Text            =   "0"
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.Frame frmDeviceSelection 
      Caption         =   "Device Selection"
      Height          =   735
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   5775
      Begin VB.CommandButton btnSelectDevice 
         Caption         =   "Select Device"
         Height          =   375
         Left            =   4080
         TabIndex        =   2
         Top             =   240
         Width           =   1455
      End
      Begin VB.Label labDeviceName 
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   3855
      End
   End
End
Attribute VB_Name = "formFout"
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 ptFreqOutStart As PT_FreqOutStart
Public DeviceNum As Long
Public DriverHandle As Long
Public ErrorNum As Long
Public lBoardID As Long
Public usMaxFoutNum As Integer

Public bRun As Boolean

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


Private Sub btnExit_Click()
   End
End Sub

Private Sub btnSelectDevice_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, DriverHandle)
   If CheckError(ErrorNum) <> 0 Then
      Exit Sub
   End If

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

   ErrorNum = DRV_DeviceGetFeatures(DriverHandle, ptDevGetFeatures)
   If CheckError(ErrorNum) <> 0 Then
      DRV_DeviceClose (DriverHandle)
      Exit Sub
   End If
   
   lBoardID = ptDevFeatures.dwBoardID
   DRV_DeviceClose (DriverHandle)
   If (lBoardID = BD_USB4751) Then
      usMaxFoutNum = 2
   Else
      usMaxFoutNum = 4
   End If
   
   cmbChannel.Clear
   While (i < usMaxFoutNum)
     cmbChannel.AddItem (Str(i))
     i = i + 1
   Wend
   
   cmbFoutSrc.Clear
   cmbFoutSrc.AddItem ("External CLK")
   cmbFoutSrc.AddItem ("20MHZ")
   cmbFoutSrc.AddItem ("10MHZ")
   cmbFoutSrc.AddItem ("5MHZ")
   cmbFoutSrc.AddItem ("1MHZ")
   cmbFoutSrc.AddItem ("100KHZ")
   
   cmbFoutSrc.ListIndex = 0
   cmbChannel.ListIndex = 0
     
   bRun = False
   btnStop.Enabled = False
   
End Sub

Private Sub btnStart_Click()
   Dim iSrc As Integer
  
   ErrorNum = DRV_DeviceOpen(DeviceNum, DriverHandle)
   If CheckError(ErrorNum) <> 0 Then
      Exit Sub
   End If

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

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

   ' check number of counter channels
   If ptDevFeatures.usMaxTimerChl = 0 Then
      MsgBox "No Counter Channel", vbInformation, "Driver Message"
      DRV_DeviceClose (DriverHandle)
      Exit Sub
   End If
   
   'start Fout
   iSrc = cmbFoutSrc.ListIndex
   Select Case iSrc
          Case 0
          ptFreqOutStart.usFoutSrc = PA_FOUT_SRC_EXTER_CLK
          Case 1
          ptFreqOutStart.usFoutSrc = PA_FOUT_SRC_CLK_20MHZ
          Case 2
          ptFreqOutStart.usFoutSrc = PA_FOUT_SRC_CLK_10MHZ
          Case 3
          ptFreqOutStart.usFoutSrc = PA_FOUT_SRC_CLK_5MHZ
          Case 4
          ptFreqOutStart.usFoutSrc = PA_FOUT_SRC_CLK_1MHZ
          Case 5
          ptFreqOutStart.usFoutSrc = PA_FOUT_SRC_CLK_100KHZ
    End Select
    
       
          ptFreqOutStart.usChannel = StrToUs(cmbChannel.Text)
          ptFreqOutStart.usDivider = StrToUs(txtDivider.Text)
          
          ErrorNum = DRV_FreqOutStart(DriverHandle, ptFreqOutStart)
          If CheckError(ErrorNum) <> 0 Then
             DRV_DeviceClose (DriverHandle)
             Exit Sub
          End If
          
          frmDeviceSelection.Enabled = False
          frmChannel.Enabled = False
          frmFoutSrc.Enabled = False
          frmDivider.Enabled = False
          btnStart.Enabled = False
          btnExit.Enabled = False
          btnStop.Enabled = True
          bRun = True
             
End Sub

Private Sub btnStop_Click()
    Dim inChannel As Integer
    inChannel = Val(cmbChannel.Text)
    ErrorNum = DRV_FreqOutReset(DriverHandle, inChannel)
    ErrorNum = DRV_DeviceClose(DriverHandle)
    
    frmDeviceSelection.Enabled = True
    frmChannel.Enabled = True
    frmFoutSrc.Enabled = True
    frmDivider.Enabled = True
    btnStart.Enabled = True
    btnExit.Enabled = True
    btnStop.Enabled = False
    bRun = False
    
End Sub

Private Sub Form_Load()
    btnSelectDevice_Click
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


Private Sub Form_Terminate()
    If (bRun = True) Then
      Call btnStop_Click
    End If
      
End Sub

Public Function StrToUs(ByVal szString As String) As Integer
    Dim temp As Long
    temp = szString
    CopyMemory StrToUs, ByVal VarPtr(temp), 2
End Function

⌨️ 快捷键说明

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