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

📄 ad_form.frm

📁 此为用vb编写的usb高速数据采集实例 如果没有相应的驱动
💻 FRM
📖 第 1 页 / 共 3 页
字号:
DA_Form.Show
End Sub

Private Sub DigitShow_Click()
    ProcessMode = 1
End Sub

Private Sub Form_Load()
    Dim i As Integer
    For i = 0 To 15
        AD_Module.flag(i) = False
        DstChannelText.Item(Channel).Enabled = False
    Next i
    '以下是对硬件参数预置初值
    AD_Module.ADPara.FirstChannel = 0    ' 置首通道为0
    AD_Module.ADPara.LastChannel = 1     ' 置末通道为1
    
    ' 以下是对参数控件预置初值
    FirstChannel_Combo = AD_Module.ADPara.FirstChannel
    LastChannel_Combo = AD_Module.ADPara.LastChannel

    Stop_Command.Enabled = False
    CloseFile.Enabled = False
    数据存盘.Enabled = False
    KW_Text.Enabled = False
    MW_Text.Enabled = False

    ProcessMode = 1    ' 使最初的数据处理方式为数字电压显示方式
    DigitOpt = True    ' 同上
    bWriteFile = False
    
    Picture1.ScaleMode = 3
    Pwidth = Picture1.Width
    
    AD_Module.DeviceID = 0       ' 设当前被操作的USB设备只有一个
    AD_Module.hDevice = USB2013_CreateDevice(AD_Module.DeviceID)     '创建设备对象
    If AD_Module.hDevice = INVALID_HANDLE_VALUE Then
      MessageBox AD_Form.hwnd, "创建设备对象失败...", "Error", 0
    End If
End Sub

Private Sub FirstChannel_Combo_Click()
    Dim FirstChannel As Long
    FirstChannel = FirstChannel_Combo
    If FirstChannel > AD_Module.ADPara.LastChannel Then
       MsgBox "首通道不能大于末通道!"
       Exit Sub
    End If
    AD_Module.ADPara.FirstChannel = FirstChannel_Combo
End Sub

Private Sub Form_Unload(Cancel As Integer)
 USB2013_ReleaseDevice AD_Module.hDevice
End Sub

Private Sub LastChannel_Combo_Click()
    Dim LastChannel As Long
    LastChannel = LastChannel_Combo
    If LastChannel < AD_Module.ADPara.FirstChannel Then
       MsgBox "末通道不能小于首通道!"
       Exit Sub
    End If
    AD_Module.ADPara.LastChannel = LastChannel_Combo
End Sub

Private Sub Newbuild_Click()
    Dim bSuccess As Boolean
    Dim DeviceID As Long
    Dim nFileName As String
    DeviceID = 0  ' 设当前被操作的PCI设备只有一个
    AD_Module.hDeviceFile = USB2013_CreateDevice(DeviceID)    '创建设备对象
    NewDialog.DefaultExt = "Usb"
    NewDialog.Filter = "Usb"
    NewDialog.DialogTitle = "新建数据文件"
    NewDialog.ShowOpen
    If DigitOpt.Value = True Then
        DataShowSytle = 0
     ElseIf WaveShowOpt.Value = True Then
        DataShowSytle = 1
     End If
    nFileName = NewDialog.FileName
    nFileID = 0
    
   AD_Module.hFileObject = USB2013_CreateFileObject(AD_Module.hDeviceFile, nFileName, USB2013_modeCreate Or USB2013_modeWrite)
    
   If AD_Module.hFileObject = INVALID_HANDLE_VALUE Then
        MsgBox "初始化错"
        Exit Sub
   End If
    AD_Form.Caption = AD_Form.Caption + " (" + nFileName + ")"
    DigitOpt.Enabled = False
    WaveShowOpt.Enabled = False
    数据存盘.Enabled = True
    ProcessMode = 3
    newbuild.Enabled = False
    数据存盘.SetFocus
    bWriteFile = True
End Sub

Public Sub Open_Click()
  HistoryView.Show
End Sub

Private Sub CloseFile_Click()
    Dim bStatus As Boolean
    bStatus = USB2013_ReleaseFile(AD_Module.hFileObject)
    If bStatus = False Then
        MsgBox "ReleaseDeviceFile Object Failed."
        Exit Sub
    End If
   
    AD_Form.Caption = "USB2013 AD 数据采集系统"
    KW_ProgressBar.Value = 0
    MW_ProgressBar.Value = 0
    KW_Text.Text = " "
    MW_Text.Text = " "
    newbuild.Enabled = True
    CloseFile.Enabled = False
    bWriteFile = False
    DataShowSytle = 0
    DigitOpt.Value = True
End Sub

Private Sub savedigit_Click()
    Call Open_Click
End Sub

Private Sub stopcollect_Click()
    Call Stop_Command_Click
End Sub

Private Sub Timer1_Timer()
   ProgressBar.Value = AD_Module.ReadIndex
   KW_ProgressBar.Value = AD_Module.m_Wrote8KWCounter
   KW_Text.Text = str$(AD_Module.m_Wrote8KWCounter * 8)
   MW_ProgressBar.Value = AD_Module.m_WroteMB
   MW_Text.Text = str$(AD_Module.m_WroteMB)
End Sub

Private Sub DigitOpt_Click()
    ProcessMode = 1        '=1:数字方式显示
End Sub

Private Sub WaveShow_Click()
  ProcessMode = 2
End Sub

Private Sub WaveShowOpt_Click()
   ProcessMode = 2       '=2:图形方式显示
End Sub



Private Sub 数据存盘_Click()
   ProcessMode = 3          '=3:数据存盘
End Sub

Public Sub Start_Command_Click()
    Dim bStatus As Boolean
    Dim b As Boolean
    Dim Channel As Long
    Dim i As Integer
    Dim m_bFirstCreateDeviceFile As Boolean
    If bWriteFile = True Then
        If Not m_bFirstCreateDeviceFile Then     ' 如果创建了文件对象
            Hist_Header.HeaderSizeBytes = Len(Hist_Header)
            Hist_Header.FileType = AD_FILE_TYPE
            
            Hist_Header.BusType = DEFAULT_BUS_TYPE
            Hist_Header.DeviceNum = DEFAULT_DEVICE_NUM    '我公司板卡号
            
            
            Hist_Header.ADPara.FirstChannel = AD_Module.ADPara.FirstChannel
            Hist_Header.ADPara.LastChannel = AD_Module.ADPara.LastChannel
            Hist_Header.VoltBottomRange = VOLT_BOTTOM_RANGE
            Hist_Header.VoltTopRange = VOLT_TOP_RANGE
            Hist_Header.FileEndFlag = FILE_END_FLAG
            
            bStatus = AD_Module.WriteFileHeader(AD_Module.hFileObject, Hist_Header, Hist_Header.HeaderSizeBytes)  ' 写入文件头信息(预定为256字节)
        End If
    End If
    PerLsbVolt = 10000# / 4096    ' 求出单位Lsb分配的电压值
    Collect_Text.Text = "数据正在采集中.........."
    Start_Command.Enabled = Not Start_Command.Enabled
    Stop_Command.Enabled = True
    FirstChannel_Combo.Enabled = False
    LastChannel_Combo.Enabled = False
    FirstChannel_Combo.BackColor = &H8000000F
    LastChannel_Combo.BackColor = &H8000000F
    For Channel = AD_Module.ADPara.FirstChannel To AD_Module.ADPara.LastChannel
        AD_Module.flag(Channel) = True
        DstChannelText.Item(Channel).Enabled = True
    Next Channel
    For i = 0 To 15       '每次重新开始时,置每个通道为空
        DstChannelText(i).Caption = " "
    Next i
    ChannelCount = (AD_Module.ADPara.LastChannel - AD_Module.ADPara.FirstChannel) + 1  '通道总数
    PerHeight = Picture1.ScaleHeight / (ChannelCount)   '求出绘制每个通道数据的Y轴高度
    middle1 = 4096# / PerHeight        '根据设备的Bit位数,求出单位象素分配的Lsb数量,以便将采集的AD数据转换成Y轴方向的象素个数
    Picture1.DrawWidth = 1
    
    AD_Module.bDeviceRun = True  ' 置设备准运行标志
    AD_Module.m_Wrote8KWCounter = 0
    hEvent = USB2013_CreateSystemEvent()
    
    Set CollectDataThread = New ThreadObject
    Set ProcessDataThread = New ThreadObject
    ProcessDataThread.Initialize AddressOf ProcessDataFunction
    ProcessDataThread.Enable = True
    CollectDataThread.Initialize AddressOf CollectDataFunction
    CollectDataThread.Enable = True
    
    
End Sub

Public Sub Stop_Command_Click()
    Dim bStatus As Boolean
    Dim Channel As Long
    Dim ReleasehDevic As Long
    ReleasehDevic = USB2013_CreateDevice(AD_Module.DeviceID)
   
    
    AD_Module.bDeviceRun = False     '置设备停止标志
    
      ProcessDataThread.Enable = False
    bStatus = USB2013_ReleaseDeviceAD(ReleasehDevic)
    bStatus = USB2013_ReleaseDevice(ReleasehDevic)
     ' bStatus = USB2013_ReleaseDeviceAD(AD_Module.hDevice)

     ' 以下是恢复有关状态
     Collect_Text.Text = "  "

     Stop_Command.Enabled = Not Stop_Command.Enabled
     Start_Command.Enabled = True
     FirstChannel_Combo.Enabled = True
     LastChannel_Combo.Enabled = True
     CloseFile.Enabled = True
     DigitOpt.Enabled = True
     WaveShowOpt.Enabled = True
    
    数据存盘.Enabled = False

     FirstChannel_Combo.BackColor = &HFFFFFF
     LastChannel_Combo.BackColor = &HFFFFFF
     For Channel = AD_Module.ADPara.FirstChannel To AD_Module.ADPara.LastChannel
        AD_Module.flag(Channel) = False  ' 将数字显示窗口标志置成无效,以便重新定位数字刷新窗口
        DstChannelText.Item(Channel).Enabled = False
     Next Channel
     
     CollectDataThread.Enable = False
     
End Sub

Private Sub CheckDIO_Click()
    DIO_Form.SetFocus
End Sub

Private Sub closecollect_Click()
   Unload Me
End Sub

Private Sub sys_Click()
    关于sys.Show
End Sub

Private Sub exit_Click()
    End
End Sub

Public Sub DrawWaveProc()
    Dim Status As Boolean, num As Integer
    Dim CurrentIndexNow As Long
    Dim x As Integer
    Original = PerHeight / 2
    Picture1.Refresh
    'Picture1.BackColor = RGB(0, 0, 0)
    x = 0   '开始绘制每通道数据时,将屏幕X坐标定位在窗口的最边位置,防止产生多余波形
    For Channel = 0 To ChannelCount  ' 绘制所有有效通道数据
        Pointlxy(x).x = x   '开始绘制每通道数据时,将屏幕X坐标定位在窗口的0位置
        ' 求出该通道第一个点的Y轴原始坐标OldY
        Pointlxy(x).y = Original - (((AD_Module.pADBuffer(Channel, AD_Module.CurrentIndex) And &HFFF) - 2048) / middle1)
        For Index = 0 To Pwidth * ChannelCount Step ChannelCount  '绘制该通道的所有数据 2048
         ' 求出相对于OldY的第二个点的Y轴新坐标
            x = x + 1       '绘制完一个点后,将X轴向的坐标往右偏移一个象素位置
            Pointlxy(x).x = x
            Pointlxy(x).y = Original - (((AD_Module.pADBuffer(Channel + Index, AD_Module.CurrentIndex) And &HFFF) - 2048) / middle1)
        Next Index  ' 绘制完某个通道的数据
        
        Polyline Picture1.hdc, Pointlxy(0), x             ' 根据Y轴新旧坐标绘制曲线
        x = 0
        Original = Original + PerHeight  ' 确定下一个通道的原点Y轴坐标
    Next Channel
      ' 如果已处理整个级链缓冲区的的末端,则将索引指针恢复至0,再重新开始
  
    
End Sub
     
Public Sub ShowDigitProc()
     Dim Channel As Integer
     Dim i As Long
     For Channel = ADPara.FirstChannel To ADPara.LastChannel
            DstChannelText(Channel).Caption = Format(((AD_Module.pADBuffer(Channel, AD_Module.CurrentIndex) And &HFFF) - 2048) * PerLsbVolt, "#.00")
     Next Channel
     
    ' 如果已处理整个级链缓冲区的的末端,则将索引指针恢复至0,再重新开始
End Sub

 Public Sub SaveProc()
    Dim bSuccess As Boolean
    bSuccess = USB2013_WriteFile(AD_Module.hFileObject, pADBuffer(0, AD_Module.CurrentIndex), AD_Module.ReadSizeWords * 2) '将8192个字的数据存放在硬盘上
    If AD_Module.m_Wrote8KWCounter >= 128 Then   '当写入1M数据)
       AD_Module.m_WroteMB = AD_Module.m_WroteMB + 1 ' 写入1M字数据
       AD_Module.m_Wrote8KWCounter = 0
    Else
       AD_Module.m_Wrote8KWCounter = AD_Module.m_Wrote8KWCounter + 2
    End If
End Sub

⌨️ 快捷键说明

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