startup.frm

利用psoc进行usb及capsense的程序编写

      TabIndex        =   0
      Top             =   360
      Width           =   1815
   End
End
Attribute VB_Name = "StartUp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' This is the Host Companion program for Example 3
'
' Copyright 2005, John Hyde, USB Design By Example
' You may use this program for development but you may not sell or publish it
' without written permission from the author
'
' Send comments or questions to john@USB_By_Example.com
'
' NOTE: if you want to experiment with plugging and unplugging the device
' then you should ensure that it is powered via USB.  To do this:
'   a) unplug the ICE-Cube cable or Mini-programmer
'   b) set jumper P3, Vreg, to VBUS
' LED5 will now display VBUS (the LCD also goes off with no VBUS)
'
'
Dim Data(255) As Byte
Dim SavedData(255) As Byte
Public ReadHandle, WriteHandle, ReadEvent As Long
Dim InReport(3) As Byte
Dim ReadOverlap As OVERLAPPED
Dim SystemName As String

Sub Form_Load()
' Clear data on entry
Dim i As Integer
SystemName = ""
Message.Text = "Looking for Process Monitoring Device"
For i = 0 To 255: Data(i) = 0: Next i
For i = 0 To 255: SavedData(i) = 0: Next i
' I do asyncnronous reads so I need an object to wait on
ReadEvent = CreateEvent(0, False, False, 0)
If (ReadEvent = 0) Then
    Message.Text = "Could not create ReadEvent, please exit"
    Stop
Else
    ReadOverlap.Offset = 0
    ReadOverlap.OffsetHigh = 0
    ReadOverlap.hEvent = ReadEvent
    End If
End Sub

Private Sub DrawGraph()
' Use an X-scaling of 25 and a Y-scaling of 10
' Display Data at 3 pixels and SavedData at 1 pixel in case they overlap
Dim i As Integer
Graph.Cls
Graph.DrawWidth = 3
Graph.CurrentX = 0: Graph.CurrentY = Graph.Height
For i = 0 To 255: Graph.Line -(25 * i, Graph.Height - (10 * Data(i))), vbBlue: Next i
Graph.DrawWidth = 1
Graph.CurrentX = 0: Graph.CurrentY = Graph.Height
For i = 0 To 255: Graph.Line -(25 * i, Graph.Height - (10 * SavedData(i))), vbRed: Next i
End Sub

Private Sub SampleRate_Change()
If (SampleRate.Value < 4) Then
    Maximum.Caption = SampleRate.Value * 256 & " msec"
Else
    Maximum.Caption = SampleRate.Value / 4 & " sec"
    End If
End Sub

Private Sub Continuous_Click()
Dim Sample_Rate(1) As Byte
Dim BytesWritten, Success As Long
If (Continuous.Caption = "Stop") Then
    Continuous.Caption = "Continuous Samples"
    Sample_Rate(0) = 0
    Sample_Rate(1) = 0
' Device interprets a rate of 0 as STOP
    If WriteHandle Then
        Success = WriteFile(WriteHandle, Sample_Rate(0), 2, BytesWritten, 0)
        If (Success = 0) Then
            Message.Text = "Error " & GetLastError() & " sending command to device"
            Call CloseProcessMonitoringDevice
            Exit Sub
            End If
        End If
Else
    Continuous.Caption = "Stop"
    Do
        Call GetOneSample
' Continue to look for buttons clicks etc so that I can exit this loop!
        DoEvents
        If (Continuous.Caption <> "Stop") Then Exit Sub
        Loop
    End If
End Sub

Private Sub GetSamples_Click()
Call GetOneSample
End Sub

Private Sub GetOneSample()
Dim i As Integer
Dim Sample_Rate(1) As Byte
Dim BytesWritten, Success As Long
Message.Text = "Collecting 256 samples"
Sample_Rate(0) = 0
Sample_Rate(1) = SampleRate.Value
If WriteHandle Then
' Clear previous samples (if any)
    HidD_FlushQueue (ReadHandle)
    Success = WriteFile(WriteHandle, Sample_Rate(0), 2, BytesWritten, 0)
    If (Success = 0) Then
        Message.Text = "Error " & GetLastError() & " sending command to device"
        Call CloseProcessMonitoringDevice
        Exit Sub
    Else
        For i = 0 To 250
            Message.Text = "Sample: " & i
            Message.Refresh
            Success = ReadInReport()
            If (Success = 0) Then
' Missed one, use previous value
                If (i) Then Data(i) = Data(i - 1)
            Else
                Data(i) = InReport(1)
                End If
            Next i
        End If
    Call DrawGraph
Else
    Message.Text = "Device is not connected"
    End If
End Sub

Private Sub Save_Click()
' Use a common dialog box to open and write a data file
Dim FileNumber, i, ErrorCode As Integer
Dim Words() As String
Dim FileName As String
Message.Text = "Save data file:"
On Error GoTo ExitNow
CD.Flags = cdlOFNHideReadOnly Or cdlOFNOverwritePrompt
CD.DialogTitle = "Please select a name for the data file"
CD.FileName = FileName
CD.ShowSave
FileName = CD.FileName
' Now open the file and read the contents
FileNumber = FreeFile()
Open FileName For Binary As #FileNumber
Put #FileNumber, , Data()
Words() = Split(FileName, "\")
Message.Text = "Data saved in " & Words(UBound(Words))
Close #FileNumber
Exit Sub
ExitNow:
ErrorCode = GetLastError()
If ErrorCode = 0 Then
    Message.Text = "Save cancelled"
Else
    Message.Text = "Error " & ErrorCode & " in Save File"
    End If
Close #FileNumber
End Sub

Private Sub Load_Click()
' Use a common dialog box to open and read a data file
Dim FileNumber, i, ErrorCode As Integer
Dim FileName As String
Dim Words() As String
Message.Text = "Load data file:"
On Error GoTo ExitNow
CD.Flags = cdlOFNFileMustExist
CD.DialogTitle = "Please select a data file to load"
CD.ShowOpen
FileName = CD.FileName
' Now open the file and read the contents
FileNumber = FreeFile()
Open FileName For Binary As #FileNumber
Get #FileNumber, 1, SavedData()
Words() = Split(FileName, "\")
Message.Text = Words(UBound(Words)) & " data read"
Close #FileNumber
Call DrawGraph
Exit Sub
ExitNow:
ErrorCode = GetLastError()
If ErrorCode = 0 Then
    Message.Text = "Load cancelled"
Else
    Message.Text = "Error " & ErrorCode & " in Load File"
    End If
Close #FileNumber
End Sub

Private Function ReadInReport() As Long
Dim Success, BytesRead, Result As Long
If (ReadHandle) Then
    Success = ReadFile(ReadHandle, InReport(0), 3, BytesRead, ReadOverlap)
' Wait will depend upon the sample time
    Result = WaitForSingleObject(ReadEvent, SampleRate.Value + 10)
    Call ResetEvent(ReadEvent)
    If (Result = WAIT_TIMEOUT) Then
' Read was not successful, so cancel the request
        Result = CancelIo(ReadHandle)
        ReadInReport = 0
    Else
        ReadInReport = 1
        End If
    End If
End Function

Public Sub OpenProcessMonitoringDevice()
' I know this is a HID device with a specific VID and PID.
' I also search for the UsagePage that defines the data reports
SystemName = FindHIDInterface(&H4242, &HEE03, &HFF03)
If SystemName = "" Then
    Message.Text = "Could not find Process Monitoring Device"
    ReadHandle = 0
    WriteHandle = 0
    GetSamples.Visible = False
    Continuous.Visible = False
Else
    Message.Text = "Process Monitoring Device found"
    ReadHandle = OpenForRead(SystemName)
    WriteHandle = OpenForWrite(SystemName)
    GetSamples.Visible = True
    Continuous.Visible = True
    End If
End Sub

Private Sub Exit_Click()
Message.Text = "Program Closing"
Call CloseProcessMonitoringDevice
Stop
End Sub

Private Sub CloseProcessMonitoringDevice()
If ReadHandle Then CloseHandle (ReadHandle)
ReadHandle = 0
If WriteHandle Then CloseHandle (WriteHandle)
WriteHandle = 0
End Sub

Private Sub Timer_Timer()
' This fires every second
' If device is not open then look for it
Dim TestHandle As Long
Dim SA As SECURITY_ATTRIBUTES
If ReadHandle = 0 Then
    Call OpenProcessMonitoringDevice
' If device is open check that it is still connected
Else
    If (SystemName <> "") Then
        TestHandle = CreateFile(SystemName, 0, FILE_SHARE_READWRITE, SA, OPEN_EXISTING, 0, 0)
        If TestHandle = INVALID_DEVICE_HANDLE Then Call CloseProcessMonitoringDevice
        CloseHandle (TestHandle)
        End If
    End If
End Sub