frmmain.frm

非常好的的USB 接口程序 基于pic单片机

      Left            =   2400
      TabIndex        =   22
      Top             =   3360
      Width           =   735
   End
   Begin VB.Label Label4 
      Caption         =   "times on Pin A"
      Height          =   255
      Left            =   2400
      TabIndex        =   19
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      Caption         =   "Send Data:"
      Height          =   255
      Left            =   0
      TabIndex        =   13
      Top             =   480
      Width           =   1095
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      Caption         =   "Read Data:"
      Height          =   255
      Left            =   0
      TabIndex        =   12
      Top             =   840
      Width           =   1095
   End
   Begin VB.Label lblReadData 
      Height          =   255
      Left            =   1200
      TabIndex        =   11
      Top             =   840
      Width           =   4575
   End
   Begin VB.Label lblConnect 
      Height          =   255
      Left            =   1200
      TabIndex        =   1
      Top             =   120
      Width           =   1695
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "USB Device:"
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Dim outputArray() As Long
Dim dataArray As Variant

Dim crcOK As Boolean
Dim useCRC As Boolean
Dim sampleSize As Integer

Option Explicit

Private Sub cmdClearRAM_Click()
    resetFields
    
    txtByte(0).Text = "8"
    cmdOnce_Click
End Sub

Private Sub cmdClearUseCRC_Click()
    resetFields
    
    txtByte(0).Text = "11"
    useCRC = False
    cmdOnce_Click
End Sub

Private Sub cmdDemoWritePortB_Click()
    txtWritePort.Text = "1"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "2"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "4"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "8"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "16"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "32"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "64"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "128"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "64"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "32"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "16"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "8"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "4"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "2"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "1"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "3"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "7"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "15"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "31"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "63"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "127"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "255"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "254"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "252"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "248"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "240"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "224"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "192"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "128"
    cmdWritePort_Click
    Sleep (100)
    txtWritePort.Text = "0"
    cmdWritePort_Click
    Sleep (100)
End Sub

Private Sub cmdReadADCByte_Click()
    txtByte(0).Text = "4"
    txtByte(1).Text = txtReadADCBytePin.Text
    cmdOnce_Click
    txtReadADCByteValue.Text = Val(ReadBuffer(3))
End Sub

Private Sub cmdReadADCnTimes_Click()
    resetFields

    txtByte(0).Text = "5"
    txtByte(1).Text = Str(Int(Int(txtReadADCnTimes.Text) / 256))
    txtByte(2).Text = Str(Int(txtReadADCnTimes.Text) - Int(Int(txtReadADCnTimes.Text) / 256) * 256)
    txtByte(3).Text = txtReadADCnTimesPin.Text
    cmdOnce_Click
End Sub

Private Sub cmdReadADCnTimesMS_Click()
    Dim theText As String
    Dim i As Integer
    
    resetFields

    txtByte(0).Text = "7"
    txtByte(1).Text = Str(Int(Int(txtReadADCnTimesMS.Text) / 256))
    txtByte(2).Text = Str(Int(txtReadADCnTimesMS.Text) - Int(Int(txtReadADCnTimesMS.Text) / 256) * 256)
    txtByte(3).Text = Str(Int(Int(txtReadADCnTimesMSValue.Text) / 256))
    txtByte(4).Text = Str(Int(txtReadADCnTimesMSValue.Text) - Int(Int(txtReadADCnTimesMSValue.Text) / 256) * 256)
    txtByte(5).Text = txtReadADCnTimesMSPin.Text
    cmdOnce_Click
End Sub

Private Sub cmdReadADCnTimesUS_Click()
    Dim theText As String
    Dim i As Integer
    
    resetFields

    txtByte(0).Text = "12"
    txtByte(1).Text = Str(Int(Int(txtReadADCnTimesUS.Text) / 256))
    txtByte(2).Text = Str(Int(txtReadADCnTimesUS.Text) - Int(Int(txtReadADCnTimesUS.Text) / 256) * 256)
    txtByte(3).Text = Str(Int(Int(txtReadADCnTimesUSValue.Text) / 256))
    txtByte(4).Text = Str(Int(txtReadADCnTimesUSValue.Text) - Int(Int(txtReadADCnTimesUSValue.Text) / 256) * 256)
    txtByte(5).Text = txtReadADCnTimesUSPin.Text
    cmdOnce_Click
End Sub

Private Sub cmdReadPin_Click()
    resetFields
    
    txtByte(0).Text = "15"
    txtByte(1).Text = txtReadPin.Text
    cmdOnce_Click
    txtReadPinValue.Text = ReadBuffer(4)
End Sub

Private Sub cmdReadPort_Click()
    resetFields
    
    txtByte(0).Text = "13"
    cmdOnce_Click
    txtReadPort.Text = ReadBuffer(3)
End Sub

Private Sub cmdReadRAMByte_Click()
    txtByte(0).Text = "2"
    txtByte(1).Text = Str(Int(Int(txtReadRAMByte.Text) / 256))
    txtByte(2).Text = Str(Int(txtReadRAMByte.Text) - Int(Int(txtReadRAMByte.Text) / 256) * 256)
    cmdOnce_Click
    txtReadRAMByteValue.Text = Val(ReadBuffer(5))
End Sub

Private Sub cmdReadRAMData_Click()
    Dim theText As String
    Dim i As Integer
    
    resetFields

    For i = 0 To sampleSize
        DoEvents
        txtByte(0).Text = "2"
        txtByte(1).Text = Str(Int(i / 256))
        txtByte(2).Text = Str(i - Int(i / 256) * 256)
        cmdOnce_Click
        dataArray(i) = Val(ReadBuffer(5))
    Next

    theText = "("
    For i = 1 To UBound(dataArray)
        theText = theText & Str(dataArray(i - 1)) & ","
    Next
    txtInput.Text = Mid(theText, 1, Len(theText) - 1) & ")"
End Sub

Private Sub cmdSetRAMByte_Click()
    resetFields
    
    txtByte(0).Text = "9"
    txtByte(1).Text = txtSetRAMByte
    cmdOnce_Click
End Sub

Private Sub cmdSetUseCRC_Click()
    resetFields
    
    txtByte(0).Text = "10"
    useCRC = True
    cmdOnce_Click
End Sub

Private Sub cmdWritePin_Click()
    resetFields
    
    txtByte(0).Text = "16"
    txtByte(1).Text = txtWritePin.Text
    txtByte(2).Text = txtWritePinValue.Text
    cmdOnce_Click
End Sub

Private Sub cmdWritePort_Click()
    resetFields
    
    txtByte(0).Text = "14"
    txtByte(1).Text = txtWritePort.Text
    cmdOnce_Click
End Sub

Private Sub cmdWriteRAMByte_Click()
    txtByte(0).Text = "3"
    txtByte(1).Text = Str(Int(Int(txtWriteRAMByte.Text) / 256))
    txtByte(2).Text = Str(Int(txtWriteRAMByte.Text) - Int(Int(txtWriteRAMByte.Text) / 256) * 256)
    txtByte(3).Text = txtWriteRAMByteValue.Text
    cmdOnce_Click
End Sub

Private Sub Form_Load()
    frmMain.Show
    tmrDelay.Enabled = False
    
    sampleSize = 511
    useCRC = True
    
    ReDim dataArray(sampleSize) As Integer
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim Result As Long
    
    Result = CloseHandle(HIDHandle)
    Result = CloseHandle(ReadHandle)
End Sub


Private Sub cmdOnce_Click()
    Dim x As Integer
    Dim theCRC As Byte
    
    If Not MyDeviceDetected Then
        MyDeviceDetected = FindTheHid
    End If
    If MyDeviceDetected Then
        OutputReportData(0) = Val(txtByte(0).Text)
        OutputReportData(1) = Val(txtByte(1).Text)
        OutputReportData(2) = Val(txtByte(2).Text)
        OutputReportData(3) = Val(txtByte(3).Text)
        OutputReportData(4) = Val(txtByte(4).Text)
        OutputReportData(5) = Val(txtByte(5).Text)
        OutputReportData(6) = Val(txtByte(6).Text)
        OutputReportData(7) = Val(txtByte(7).Text)
    
        Call ReadAndWriteToDevice
        lblReadData = Str$(ReadBuffer(1)) & "," & Str$(ReadBuffer(2)) & "," & Str$(ReadBuffer(3)) & "," & Str$(ReadBuffer(4)) & "," & Str$(ReadBuffer(5)) & "," & Str$(ReadBuffer(6)) & "," & Str$(ReadBuffer(7)) & "," & Str$(ReadBuffer(8))
        If useCRC Then
            theCRC = calc_CRC(0, ReadBuffer(1))
            theCRC = calc_CRC(theCRC, ReadBuffer(2))
            theCRC = calc_CRC(theCRC, ReadBuffer(3))
            theCRC = calc_CRC(theCRC, ReadBuffer(4))
            theCRC = calc_CRC(theCRC, ReadBuffer(5))
            theCRC = calc_CRC(theCRC, ReadBuffer(6))
            theCRC = calc_CRC(theCRC, ReadBuffer(7))
            If theCRC = ReadBuffer(8) Then
                lblReadData = lblReadData & " CRC OK"
                crcOK = True
            Else
                lblReadData = lblReadData & " CRC BAD"
                crcOK = False
            End If
        End If
    End If
End Sub

Public Sub resetFields()
    Dim i As Integer
    For i = 0 To 7
        txtByte(i).Text = "255"
    Next
End Sub

Private Sub timerCheckConnection_Timer()
    If FindTheHid Then
        lblConnect.Caption = "Connected"
        lblConnect.ForeColor = RGB(0, 150, 0)
    Else
        lblConnect.Caption = "Disconnected"
        lblConnect.ForeColor = RGB(150, 0, 0)
    End If
End Sub

Private Sub tmrDelay_Timer()
    Timeout = True
    tmrDelay.Enabled = False
End Sub

Private Sub txtReadADCBytePin_Change()
    If Val(txtReadADCBytePin.Text) < 0 Then
        txtReadADCBytePin.Text = 0
    ElseIf Val(txtReadADCBytePin.Text) > 4 Then
        txtReadADCBytePin.Text = 4
    End If
End Sub

Private Sub txtReadADCnTimes_Change()
    If Val(txtReadADCnTimes.Text) < 0 Then
        txtReadADCnTimes.Text = 0
    ElseIf Val(txtReadADCnTimes.Text) > sampleSize Then
        txtReadADCnTimes.Text = sampleSize
    End If
End Sub

Private Sub txtReadADCnTimesMS_Change()
    If Val(txtReadADCnTimesMS.Text) < 0 Then
        txtReadADCnTimesMS.Text = 0
    ElseIf Val(txtReadADCnTimesMS.Text) > sampleSize Then
        txtReadADCnTimesMS.Text = sampleSize
    End If
End Sub

Private Sub txtReadADCnTimesMSPin_Change()
    If Val(txtReadADCnTimesMSPin.Text) < 0 Then
        txtReadADCnTimesMSPin.Text = 0
    ElseIf Val(txtReadADCnTimesMSPin.Text) > 4 Then
        txtReadADCnTimesMSPin.Text = 4
    End If
End Sub

Private Sub txtReadADCnTimesPin_Change()
    If Val(txtReadADCnTimesPin.Text) < 0 Then
        txtReadADCnTimesPin.Text = 0
    ElseIf Val(txtReadADCnTimesPin.Text) > 4 Then
        txtReadADCnTimesPin.Text = 4
    End If
End Sub

Private Sub txtReadADCnTimesUS_Change()
    If Val(txtReadADCnTimesUS.Text) < 0 Then
        txtReadADCnTimesUS.Text = 0
    ElseIf Val(txtReadADCnTimesUS.Text) > sampleSize Then
        txtReadADCnTimesUS.Text = sampleSize
    End If
End Sub

Private Sub txtReadADCnTimesUSPin_Change()
    If Val(txtReadADCnTimesUSPin.Text) < 0 Then
        txtReadADCnTimesUSPin.Text = 0
    ElseIf Val(txtReadADCnTimesUSPin.Text) > 4 Then
        txtReadADCnTimesUSPin.Text = 4
    End If
End Sub

Private Sub txtReadPin_Change()
    If Val(txtReadPin.Text) < 0 Then
        txtReadPin.Text = 0
    ElseIf Val(txtReadPin.Text) > 7 Then
        txtReadPin.Text = 7
    End If
End Sub

Private Sub txtReadRAMByte_Change()
    If Val(txtReadRAMByte.Text) < 0 Then
        txtReadRAMByte.Text = 0
    ElseIf Val(txtReadRAMByte.Text) > sampleSize Then
        txtReadRAMByte.Text = sampleSize
    End If
End Sub

Private Sub txtSetRAMByte_Change()
    If Val(txtSetRAMByte.Text) < 0 Then
        txtSetRAMByte.Text = 0
    ElseIf Val(txtSetRAMByte.Text) > 255 Then
        txtSetRAMByte.Text = 255
    End If
End Sub

Private Sub txtWritePin_Change()
    If Val(txtWritePin.Text) < 0 Then
        txtWritePin.Text = 0
    ElseIf Val(txtWritePin.Text) > 7 Then
        txtWritePin.Text = 7
    End If
End Sub

Private Sub txtWritePinValue_Change()
    If Val(txtWritePinValue.Text) < 0 Then
        txtWritePinValue.Text = 0
    ElseIf Val(txtWritePinValue.Text) > 1 Then
        txtWritePinValue.Text = 1
    End If
End Sub

Private Sub txtWritePort_Change()
    If Val(txtWritePort.Text) < 0 Then
        txtWritePort.Text = 0
    ElseIf Val(txtWritePort.Text) > 255 Then
        txtWritePort.Text = 255
    End If
End Sub

Private Sub txtWriteRAMByte_Change()
    If Val(txtWriteRAMByte.Text) < 0 Then
        txtWriteRAMByte.Text = 0
    ElseIf Val(txtWriteRAMByte.Text) > sampleSize Then
        txtWriteRAMByte.Text = sampleSize
    End If
End Sub

Private Sub txtWriteRAMByteValue_Change()
    If Val(txtWriteRAMByteValue.Text) < 0 Then
        txtWriteRAMByteValue.Text = 0
    ElseIf Val(txtWriteRAMByteValue.Text) > 255 Then
        txtWriteRAMByteValue.Text = 255
    End If
End Sub