historyview.frm

此为用vb编写的usb高速数据采集实例 如果没有相应的驱动

        Call DrawWaveProc
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim flag As Boolean
    If FOpenFlag = True Then
        Timer.Enabled = False
        flag = USB2013_ReleaseFile(FileObject)
    End If
Me.Visible = False
End Sub

Private Sub OpenFile_Click()
    On Error GoTo NoFile
    Dim ReadNum As Integer
    Dim bStatus As Boolean
    Dim i As Integer, s$
  If already = False Then
   Dim aa As New HistoryView
    
    aa.Show
   
  End If
  

NoFile:
    If hDevice = INV_HANDLE_VALUE Then
        MsgBox "创建设备出错"
        FOpenFlag = False
        OpenFile.Enabled = True
    End If
    If FileObject = False Then
        MsgBox "打开文件出错"
        FOpenFlag = False
        OpenFile.Enabled = True
    End If
    If Err.Number = 32755 Then
        '没有打开文件
        FOpenFlag = False
        OpenFile.Enabled = True
    End If
End Sub



Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ScreenPos.Caption = x + m_Offset + Slider3.Value
End Sub

Private Sub DigitShow_Click()
    ShowMode = 1                '数字显示方式
    DigitOpt = True
    DigitShow.Checked = True
    WaveShow.Checked = False
End Sub

Private Sub Slider1_Scroll()
    m_Offset = Slider1.Value
    FileOffset.Caption = m_Offset
End Sub

Private Sub Slider2_Scroll()
  Dim bStatus As Boolean
  'On Error GoTo feel
    m_Offset = Slider2.Value
    FileOffset.Caption = m_Offset
    bStatus = USB2013_ReadFile(FileObject, InRegionUser(0), HeaderSize + (m_Offset * 2) * ChannelCount, 8192 * 2)
    ScreenPos.Caption = str$(Val(ScreenPos.Caption) + Rate)
    m_Offset = m_Offset + Rate
    Slider3.Value = 0
    Select Case ShowMode
        Case 1             '数字显示
            Call ShowDigitProc      '=1：数字显示
        Case 2
            Call DrawWaveProc      '=2：图形显示
    End Select
    
End Sub

Private Sub Slider3_Scroll()
  Call DrawWaveProc1
  'ScreenPos.Caption = m_Offset + Slider3.Value
End Sub

Private Sub Start_Command_Click()
    Slider1.Visible = True
    Slider2.Visible = False
    Slider1.Value = Slider2.Value
    If FOpenFlag = True Then
        Timer.Enabled = True
        Start_Command.Enabled = False
        Stop_Command.Enabled = True
        CloseFile.Enabled = False
    End If
End Sub


Private Sub StartPlay_Click()
  Start_Command_Click
End Sub

Private Sub Stop_Command_Click()
    Slider1.Visible = False
    Slider2.Visible = True
    Timer.Enabled = False
    Stop_Command.Enabled = False
    Start_Command.Enabled = True
    CloseFile.Enabled = True
    Slider2.Value = Slider1.Value
End Sub

Private Sub StopPlay_Click()
  Stop_Command_Click
End Sub

Private Sub Timer_Timer()
    ReadrawDataWindows
End Sub

Private Sub WaveShow_Click()
    ShowMode = 2                '波形显示方式
    WaveOpt = True
    DigitShow.Checked = False
    WaveShow.Checked = True
End Sub

Private Sub DigitOpt_Click()
    ShowMode = 1
    DigitShow.Checked = True
    WaveShow.Checked = False
    Call ReadrawDataWindows
    
End Sub

Private Sub WaveOpt_Click()
    ShowMode = 2
    DigitShow.Checked = False
    WaveShow.Checked = True
End Sub

Private Sub ShowDigitProc()
    Screen.MousePointer = vbHourglass
    Dim Row As Integer
    Dim Col As Integer
    Dim channelpot As Integer
    channelpot = (8192 - (8192 Mod ChannelCount))
'    MsgBox m_Offset
'    MsgBox Slider1.Value
'    MsgBox Slider2.Value
    For i = 0 To ChannelCount - 1
        s$ = s$ + "|   CH" + str$(Hist_Header.ADPara.FirstChannel + i)
    Next
    Grid.FormatString = s$
    s$ = ";"
    
     For i = 0 + m_Offset To ((channelpot / ChannelCount) - 1 + m_Offset)
    s$ = s$ + "|" + str$(i)
    Next
     Grid.FormatString = s$
    
    For Row = 1 To ((8192 - (8192 Mod ChannelCount)) / ChannelCount)
       ' Grid.TextMatrix(Row, 1) = Str$(m_Offset + Row)
        For Col = 0 To ChannelCount - 1
            Grid.TextMatrix(Row, Col + 1) = str$(InRegionUser((Row - 1) * ChannelCount + Col))
        Next
    Next
    Screen.MousePointer = vbDefault
End Sub

Private Sub DrawWaveProc1()
    Dim Status As Boolean
    Dim middle1 As Integer, PerHeight As Integer, x, y1 As Integer, y2 As Integer
    Dim smallchange As Integer
    PerHeight = Picture1.ScaleHeight / ChannelCount
    middle1 = 4096# / PerHeight
    Original = PerHeight / 2
    smallchange = Slider3.Value - (Slider3.Value Mod ChannelCount)
    Picture1.Cls
    x = 0
    For Channel = (0 + smallchange) To (Picture1.ScaleWidth * ChannelCount + smallchange) Step ChannelCount '　绘制所有有效通道数据
        Original = PerHeight / 2
        For Index = 0 To ChannelCount - 1
            y1 = Original - (((InRegionUser(Channel + Index) And &HFFF) - 2048) / middle1)
            y2 = Original - (((InRegionUser(Channel + Index + ChannelCount) And &HFFF) - 2048) / middle1)
            Picture1.Line (x, y1)-(x + 1, y2), RGB(255, 255, 255)
            
            Original = Original + PerHeight
        Next Index  '
        x = x + 1
    Next Channel
End Sub
Private Sub DrawWaveProc()
    Dim Status As Boolean
    Dim middle1 As Integer, PerHeight As Integer, x, y1 As Integer, y2 As Integer
    PerHeight = Picture1.ScaleHeight / ChannelCount
    middle1 = 4096# / PerHeight
    Original = PerHeight / 2
    Picture1.Cls
    x = 0
    For Channel = 0 To Picture1.ScaleWidth * ChannelCount Step ChannelCount    '　绘制所有有效通道数据
        Original = PerHeight / 2
        For Index = 0 To ChannelCount - 1
            y1 = Original - (((InRegionUser(Channel + Index) And &HFFF) - 2048) / middle1)
            y2 = Original - (((InRegionUser(Channel + Index + ChannelCount) And &HFFF) - 2048) / middle1)
            Picture1.Line (x, y1)-(x + 1, y2), RGB(255, 255, 255)
            
            Original = Original + PerHeight
        Next Index  '
        x = x + 1
    Next Channel
End Sub
Private Sub ReadrawDataWindows()
    Dim bStatus As Boolean
    bStatus = USB2013_ReadFile(FileObject, InRegionUser(0), HeaderSize + (m_Offset * 2) * ChannelCount, 8192 * 2)
    If bStatus = False Then '如果显示到文件尾部 自动结束
        Timer.Enabled = False
        StartPlay.Enabled = True
        StopPlay.Enabled = False
        Start_Command.Enabled = True
        Stop_Command.Enabled = False
        Exit Sub
    End If
    ScreenPos.Caption = str$(Val(ScreenPos.Caption) + Rate)
    m_Offset = m_Offset + Rate
    If Slider1.Value = Slider1.Max Then
        Timer.Enabled = False
        StartPlay.Enabled = True
        StopPlay.Enabled = False
        Start_Command.Enabled = True
        Stop_Command.Enabled = False
        Exit Sub
    End If
    Select Case ShowMode
        Case 1             '数字显示
            Call ShowDigitProc      '=1：数字显示
        Case 2
            Call DrawWaveProc       '=2：图形显示
    End Select
    Slider1.Value = Slider1.Value + Combo1
End Sub

Public Sub file()
    On Error GoTo canclen
newfiles:
Dim FileName As String
Dim cardtype, cardno, trigger As String
    hDevice = USB2013_CreateDevice(0)
    FileDialog.CancelError = True
    FileDialog.DefaultExt = "*.usb"
    FileDialog.Filter = "*.usb"
    FileDialog.FileName = "*.usb"
    FileDialog.DialogTitle = "打开数据"
    FileDialog.ShowOpen
    FileName = FileDialog.FileName                  '打开文件
     
       
    FileObject = USB2013_CreateFileObject(hDevice, FileName, USB2013_modeRead)
    FOpenFlag = True
    bStatus = ReadFileHeader(FileObject, Hist_Header, 0, Len(Hist_Header))
    HeaderSize = Len(Hist_Header)
    
    If Not ((Hist_Header.BusType = DEFAULT_BUS_TYPE) And (Hist_Header.DeviceNum = DEFAULT_DEVICE_NUM)) Then
        MsgBox "不是有效的设备文件"
        bStatus = USB2013_ReleaseFile(FileObject)
        FOpenFlag = False
        GoTo newfiles
        'Exit Sub
    End If
    If Hist_Header.BusType = DEFAULT_BUS_TYPE Then
      cardtype = "USB"
    End If
    
    Screen.MousePointer = vbHourglass
    
    FileSizeDisp.Caption = (USB2013_GetFileLength(FileObject) - HeaderSize) / 2  '显示文件长度
    
    
     FileHeadText.AddItem "板卡型号：" + cardtype, 0
     FileHeadText.AddItem "板卡类型：" + Hex(Hist_Header.DeviceNum), 1
     FileHeadText.AddItem "首通道：" + str$(Hist_Header.ADPara.FirstChannel)
     FileHeadText.AddItem "末通道：" + str$(Hist_Header.ADPara.LastChannel)
    
    ChannelCount = Hist_Header.ADPara.LastChannel - Hist_Header.ADPara.FirstChannel + 1
    PerChannel.Caption = (Val(FileSizeDisp.Caption) / ChannelCount)  '显示通道点数
    Me.Caption = "数据回放窗体  - 数据回放： [" + FileName + "]"
        
    If ChannelCount = 3 Then    '美观列表
    Grid.Width = 3100
    Picture1.Left = 4440
    Picture1.Width = 9975
    End If
    
    If ChannelCount = 2 Then    '美观列表
    Grid.Width = 2400
    Picture1.Left = 4440
    Picture1.Width = 9975
    End If
    
    If ChannelCount = 1 Then    '美观列表
    Grid.Width = 1600
    Picture1.Left = 4440
    Picture1.Width = 9975
    End If
    
    Slider1.LargeChange = 8192 / ChannelCount
    Slider1.Min = 0
    Slider1.Max = Val(FileSizeDisp.Caption) / ChannelCount  '设定滚动条范围
    Slider2.LargeChange = 8192 / ChannelCount
    Slider2.Min = 0
    Slider2.Max = Val(FileSizeDisp.Caption) / ChannelCount
    Slider3.LargeChange = 10
    Slider3.Min = 0
    Slider3.Max = Fix(8192 / ChannelCount)
    
    Start_Command.Enabled = True
    Picture1.ScaleMode = 3
    
    bStatus = USB2013_ReadFile(FileObject, InRegionUser(0), HeaderSize + (m_Offset * 2) * ChannelCount, 8192 * 2)
    Call ShowDigitProc      '数字显示
    Call DrawWaveProc       '图形显示
  '  OpenFile.Enabled = False
    CloseFile.Enabled = True
    already = False
    Screen.MousePointer = vbDefault
    Exit Sub
canclen:
    Unload Me
End Sub