form1.frm

多功能数据采集卡上位机完整代码

         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   945
         Width           =   2205
      End
      Begin VB.Label lblPSNO 
         Alignment       =   1  'Right Justify
         Caption         =   "AD板通道号:"
         Height          =   225
         Left            =   4500
         TabIndex        =   75
         Top             =   1005
         Width           =   1710
      End
      Begin VB.Label lblStatic 
         AutoSize        =   -1  'True
         Caption         =   "量程选择:"
         Height          =   225
         Index           =   2
         Left            =   960
         TabIndex        =   8
         Top             =   465
         Width           =   1020
      End
      Begin VB.Label lblStatic 
         AutoSize        =   -1  'True
         Caption         =   "显示方式:"
         Height          =   225
         Index           =   3
         Left            =   5190
         TabIndex        =   7
         Top             =   465
         Width           =   1020
      End
      Begin VB.Label lblStatic 
         AutoSize        =   -1  'True
         Caption         =   "AD板通道方式:"
         Height          =   225
         Index           =   4
         Left            =   495
         TabIndex        =   6
         Top             =   1005
         Width           =   1485
      End
   End
   Begin VB.Timer timerAD 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   11430
      Top             =   165
   End
   Begin VB.Label lblBaseAddr 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "板卡基地址"
      Height          =   360
      Left            =   1620
      TabIndex        =   1
      Top             =   120
      Width           =   1560
   End
   Begin VB.Label lblStatic 
      AutoSize        =   -1  'True
      Caption         =   "板卡基地址:"
      Height          =   225
      Index           =   1
      Left            =   255
      TabIndex        =   0
      Top             =   195
      Width           =   1245
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim m_cardNO As Long  'pci卡的板卡索引号
Dim m_floatData(819200) As Single  '申请足够大的缓冲区，应该是4096的整数倍，并且缓冲区大小至少大于4096

Public m_timerADFinish As Boolean
Public m_timerCTFinish As Boolean
Public m_timerDIFinish As Boolean

Const m_MaxADchCnt As Long = 8
Const m_MaxPSchCnt As Long = 16
Const m_CTchCount As Long = 3 '计数通道数
Const m_DIchCount As Long = 16 'DI通道数
Const m_DOchCount As Long = 16 'DI通道数
Const m_PsDIchCount As Long = 4 'DI通道数
Const m_PsDOchCount As Long = 4 'DI通道数

Private Sub DrawStr(ByRef picObj As PictureBox, _
                    ByRef rowDataStr() As String, _
                    ByVal cols As Long)
'写一行
With picObj
    If picObj Is Nothing Then MsgBox "对象不能为空": Exit Sub
    Dim arrSize As Long
    arrSize = UBound(rowDataStr) - LBound(rowDataStr) + 1
    If arrSize <= 0 Then MsgBox "数组不能为空": Exit Sub
    If cols <= 0 Then MsgBox "列数不能为0": Exit Sub
    .Cls '清屏
    .ForeColor = vbBlack
    Const DEF_ROWS As Long = 12 '18
    Const DEF_COLS As Long = 8
    
    Dim k As Long, i As Long
    'Static lastData(DEF_ROWS * DEF_COLS - 1) As Single
    Static lastArrSize  As Long
    Static lastData() As String
    If lastArrSize <> (DEF_ROWS * cols) Then
        lastArrSize = DEF_ROWS * cols
        ReDim lastData(lastArrSize - 1)
    End If
    
    '把后面向前移DEF_COLS个数
    For k = 0 To lastArrSize - cols - 1
        lastData(k) = lastData(k + cols)
    Next k
    For k = 0 To cols - 1
        lastData(k + lastArrSize - cols) = rowDataStr(k)
    Next k
    
'MsgBox Screen.TwipsPerPixelX & " , " & Screen.TwipsPerPixelY

For k = 0 To DEF_ROWS - 1
    For i = 0 To cols - 1
        '.CurrentX = (i) * 1100 + 200
        '.CurrentY = k * 200
        .CurrentX = (i) * 73 + 13
        .CurrentY = k * 15
        Dim tempStr As String
        tempStr = lastData(k * cols + i) 'Format(lastData(k * cols + i), "0.00")
        tempStr = Space(Len("+10000.00") - Len(tempStr)) & tempStr
        picObj.Print tempStr 'Format(lastData(k * 8 + i), "0.00") '"10000.00"
    Next i
Next k
End With

End Sub

Private Sub cmdTimerAD_Click()
'开始PS端子板定时采集
    If cmdTimerAD.Caption Like "开始*" Then
        '初始化显示
        Dim chCnt As Long
        chCnt = Val(cobPSNO.Text)
        If cobShowMode.ListIndex <> 3 Then
            Dim outStrArr(8 - 1) As String
            Dim k As Long
            For k = 0 To 8 - 1
                outStrArr(k) = "< CH" & k + 1 & " >" '-------"
            Next k
            DrawStr Picture1, outStrArr, chCnt
        End If
        '得到真正的量程代码
        Dim AIrange As Long
        Select Case cobADrange.ListIndex
            Case 0: '
                AIrange = AI.Range_0__5000mV
            Case 1: '
                AIrange = AI.Range_N10000__P10000mV
        End Select
        '选择板卡的AD量程(必须与板上跳线相一致)
        Call ZT8361_LoadADZeroFull(m_cardNO, AIrange, 2, 0) '从卡中读调零调满值
        'AIrange = cobADrange.ItemData(cobADrange.ListIndex)
        
        m_timerADFinish = True
        timerAD.Interval = 100
        timerAD.Enabled = True
    
        cmdTimerAD.Caption = "停止采集"
    Else
        timerAD.Enabled = False
        cmdTimerAD.Caption = "开始采集"
    End If
    If ZT8361_GetLastErr <> 0 Then Me.Caption = "PCI8361V测试程序(错误号: " & ZT8361_GetLastErr & ")" '显示当前错误号
End Sub

Private Sub timerAD_Timer()
'用于定时启动AD方式，成批读数
    
    If m_timerADFinish = False Then Exit Sub
    m_timerADFinish = False
    
    Dim retCount As Long, currCount As Long, countPerCh As Long
    Dim sum(m_MaxADchCnt - 1) As Double
    Dim wantCount As Long, k As Long, i As Long
    
    Dim AIrange As Long
    Dim showMode As Long
    showMode = cobShowMode.ListIndex
    Select Case cobADrange.ListIndex
        Case 0: '0~5V
            AIrange = IIf(showMode < 2, AI.Range_initCode, AI.Range_0__5000mV)
        Case 1: '-10~+10V
            AIrange = IIf(showMode < 2, AI.Range_initCode, AI.Range_N10000__P10000mV) + &H80000000  '双极性要加一个标志
    End Select
    
    Dim chCnt As Long
    chCnt = Val(cobPSNO.Text)
    
    currCount = chCnt * 10
    wantCount = chCnt * 10
    
    If currCount >= wantCount Then
        '
        Dim outStrArr(8 - 1) As String, tempVal As Long
        Dim showRowCnt As Long
        Dim waveNO As Long
        showRowCnt = Val(txtShowCnt.Text)
        
        Select Case showMode
            Case 0 '原码值(十六进制)
                '采集数据
                For k = 0 To chCnt - 1
                    For i = 0 To 10 - 1
                        m_floatData(i * chCnt + k) = ZT8361_AIonce(m_cardNO, 0, k + 1, AIrange, 0, 60)
                    Next i
                Next k
                If Option1(0).Value = True Then '显示每批数的前showRowCnt个值
                    For k = 0 To showRowCnt - 1
                        For i = 0 To chCnt - 1
                            outStrArr(i) = Hex(m_floatData(i))
                        Next i
                        DrawStr Picture1, outStrArr, chCnt
                    Next k
                Else '取一部分求平均值显示，不带通道号
                    '求平均
                    For k = 0 To chCnt - 1
                        sum(k) = 0
                        For i = 0 To 10 - 1
                            tempVal = m_floatData(i * chCnt + k)
                            sum(k) = sum(k) + tempVal
                        Next i
                        outStrArr(k) = Hex(sum(k) / 10#)
                    Next k
                    DrawStr Picture1, outStrArr, chCnt
                End If
            Case 1 '原码值(十进制)，不含通道号
                '采集数据
                For k = 0 To chCnt - 1
                    For i = 0 To 10 - 1
                        m_floatData(i * chCnt + k) = ZT8361_AIonce(m_cardNO, 0, k + 1, AIrange, 0, 60)
                    Next i
                Next k
                If Option1(0).Value = True Then '显示每批数的前showRowCnt个值
                    For k = 0 To showRowCnt - 1
                        For i = 0 To chCnt - 1
                            tempVal = m_floatData(i)
                            outStrArr(i) = tempVal
                        Next i
                        DrawStr Picture1, outStrArr, chCnt
                    Next k
                Else '取一部分求平均值显示，不带通道号
                    '求平均
                    For k = 0 To chCnt - 1
                        sum(k) = 0
                        For i = 0 To 10 - 1
                            tempVal = m_floatData(i * chCnt + k)
                            sum(k) = sum(k) + tempVal
                        Next i
                        outStrArr(k) = Format(sum(k) / 10#, "0.00")
                    Next k
                    DrawStr Picture1, outStrArr, chCnt
                End If
            Case 2 '显示mV值
                '采集数据
                AIrange = cobADrange.ItemData(cobADrange.ListIndex)
                For k = 0 To chCnt - 1
                    For i = 0 To 10 - 1
                        m_floatData(i * chCnt + k) = ZT8361_AIonce(m_cardNO, 0, k + 1, AIrange, 0, 60)
                    Next i
                Next k
                If Option1(0).Value = True Then '显示每批数的前showRowCnt个值
                    For k = 0 To showRowCnt - 1
                        For i = 0 To chCnt - 1
                            outStrArr(i) = Format(m_floatData(i), "0.00")
                        Next i
                        DrawStr Picture1, outStrArr, chCnt
                    Next k
                Else '取一部分求平均值显示，不带通道号
                    '求平均
                    For k = 0 To chCnt - 1
                        sum(k) = 0
                        For i = 0 To 10 - 1
                            sum(k) = sum(k) + m_floatData(i * chCnt + k)
                        Next i
                        outStrArr(k) = Format(sum(k) / 10#, "0.00")
                    Next k
                    DrawStr Picture1, outStrArr, chCnt
                End If
        End Select
    End If
    If ZT8361_GetLastErr <> 0 Then Me.Caption = "PCI8361V测试程序(错误号: " & ZT8361_GetLastErr & ")" '显示当前错误号
    m_timerADFinish = True
End Sub

Private Sub cobPsMode_Click()
    Dim i As Long
    cobPSNO.Clear
    For i = 0 To 8 - 1
        cobPSNO.AddItem i + 1
    Next i

    Select Case cobPsMode.ListIndex
        Case 0: '单板单通道
            lblPSNO.Caption = "AD板通道号:"
            lblPSNO.ForeColor = vbRed
            cobPSNO.ListIndex = 0
        Case 1: '多板单通道
            lblPSNO.Caption = "AD板中止通道号:"
            lblPSNO.ForeColor = vbBlack
            cobPSNO.ListIndex = 8 - 1
    End Select
End Sub

Private Sub cobShowMode_Click()
'选择显示方式
    Dim showMode As Long
    showMode = cobShowMode.ListIndex
    Select Case showMode
        Case 0, 1
            Option1(0).Enabled = True
            Option1(1).Enabled = True
            Option1(0).Value = True
        Case 2
            Option1(0).Enabled = True
            Option1(1).Enabled = True
            Option1(1).Value = True
        Case 3
            Option1(0).Enabled = False
            Option1(1).Enabled = False
    End Select
End Sub

Private Sub Form_Load()
'打开设备
    '窗体居中
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 3
    '打开设备
    m_cardNO = 1
    If ZT8361_OpenDevice(m_cardNO) <> 0 Then
        MsgBox "打开设备失败，找不到指定的板卡。"
        End
    End If
    lblBaseAddr.Caption = "&&H" & Hex(ZT8361_GetBaseAddr(m_cardNO)) '显示基地址
    '设置计数器相关控件
    Dim i As Long
    For i = 0 To m_CTchCount - 1
        ZT8361_CTStop m_cardNO, i + 1, 0
        cobCTmode(i).ListIndex = 3
        txtInitCTval(i).Text = 10 ^ (i + 1)
    Next i
    '所有开关量输出置低
    ZT8361_DOAll m_cardNO, 1, 0
    ZT8361_DOAll m_cardNO, 2, 0
    cobADrange.ListIndex = 0 '-10~+10V
    'cobPStype.ListIndex = 0 'ps-