main.frm

控制USB通信芯片ch372（VB端的程序）

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "USB接口测试"
   ClientHeight    =   6525
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10890
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6525
   ScaleWidth      =   10890
   Begin VB.CommandButton pnpproce 
      Caption         =   "设备插拔事件处理控件"
      Height          =   375
      Left            =   8640
      TabIndex        =   11
      Top             =   5760
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.CommandButton Command3 
      Caption         =   "刷新"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   9120
      TabIndex        =   10
      Top             =   4080
      Width           =   1095
   End
   Begin VB.TextBox TextReceive 
      BackColor       =   &H00C0FFFF&
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1815
      Left            =   1440
      MultiLine       =   -1  'True
      TabIndex        =   7
      Top             =   3000
      Width           =   6855
   End
   Begin VB.Frame FrameDatalength 
      Caption         =   "数据长度"
      Height          =   1455
      Left            =   8760
      TabIndex        =   4
      Top             =   1080
      Width           =   1695
      Begin VB.HScrollBar HScrollDataLength 
         Height          =   375
         Left            =   120
         TabIndex        =   6
         Top             =   840
         Width           =   1455
      End
      Begin VB.Label LabelDataLength 
         Caption         =   "32"
         BeginProperty Font 
            Name            =   "Times New Roman"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   360
         TabIndex        =   5
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.TextBox TextSend 
      BackColor       =   &H00C0FFFF&
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1815
      Left            =   1440
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   840
      Width           =   6855
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   9120
      TabIndex        =   1
      Top             =   5040
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发送"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   9120
      TabIndex        =   0
      Top             =   3120
      Width           =   1095
   End
   Begin VB.Label LabelDataCompare 
      Height          =   375
      Left            =   1440
      TabIndex        =   12
      Top             =   5640
      Width           =   4815
   End
   Begin VB.Label LabelReceive 
      Caption         =   "接收数据"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   3000
      Width           =   975
      WordWrap        =   -1  'True
   End
   Begin VB.Label LabelStatus 
      Height          =   255
      Left            =   1440
      TabIndex        =   8
      Top             =   5040
      Width           =   6855
   End
   Begin VB.Label LabelSend 
      Caption         =   "发送数据"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   3
      Top             =   840
      Width           =   975
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mCaptionInform As String
Dim mDemoReq As COMMAND_PACKET
Dim mOpen As Long
Const DEMO_GET_KEY = &H34
Const DEMO_RET_OK = &H0

Dim mDataLength As Long
Dim strSend As String
Dim strReceive As String

Dim mDataSend As COMMAND_PACKET
Dim mDatareceive As COMMAND_PACKET

Dim mblnStartCommunicate As Boolean

Private Sub Command2_Click()
    End
End Sub

'Dim mDataSend(1 To 64) As Byte
'Dim mdatareceive(1 To 64) As Byte
'设备插拔事件处理
Private Sub pnpproce_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim i As Byte
    Dim iEventStatus As Long
    iEventStatus = KeyCode   '插拔事件代码

    If (iEventStatus = CH375_DEVICE_ARRIVAL) Then
        If (mOpen = -1) Then  '设备没打开
            mOpen = CH375OpenDevice(mIndex)                  '设备插入后打开设备
            If mOpen = -1 Then
                MsgBox "无法打开CH375设备", vbCritical, "信息提示"
                Exit Sub
            End If
            'CH375SetTimeout mIndex, 3000, 3000
            'Call Testcommunication  '测试PC机与单片机之间的USB通讯
            Call mCallInt  '设置中断
        End If
'        For i = 0 To 7
'            Command1(i).Enabled = True 'LED
'        Next i
        'Command3.Enabled = True
        LabelStatus.Caption = "**CH372/CH375设备已插上"
        mblnStartCommunicate = True
        
    ElseIf (iEventStatus = CH375_DEVICE_REMOVE) Then
        If (mOpen <> -1) Then
            CH375CloseDevice (mIndex)     '设备拔出,关闭设备句柄
            mOpen = -1
        End If
'        For i = 0 To 7
'            Command1(i).Enabled = False
'        Next i
'        Command3.Enabled = False
        LabelStatus.Caption = "**CH372/CH375设备已拔出"
        mblnStartCommunicate = True
    End If
End Sub
Private Sub Command1_Click()
    Dim i As Integer
    Dim temp As Byte
    Dim mLength As Long
    Dim blnDataCompareError As Boolean
    
    strSend = ""
    strReceive = ""
    
    TextReceive.Text = strReceive
    
    Randomize
    For i = 1 To mDataLength
        temp = Int((255 * Rnd) + 1)
        mDataSend.mBuffer(i) = temp
        strSend = strSend & Format(temp, "000") & ", "
        If i = 15 Then
            strSend = strSend & Chr(10)
        End If
    Next
    TextSend.Text = strSend
    
    mLength = mDataLength
    blnDataCompareError = False
    
    If (CH375Writedata(mIndex, mDataSend, mLength)) Then       ' 通过CH375发送命令数据,成功
        mLength = mDataLength
        '考虑到之前单片机准备上传的数据可能未被计算机取走,导致首次回传有可能直接读到之前的数据而不是本次数据的取反,所以首次回传先等待单片机准备好取反数据
        If mblnStartCommunicate = True Then Sleep 200
        Call CH375ReadData(mIndex, mDatareceive, mLength)
        If (mLength = mDataLength) Then
            For i = 1 To mLength
                temp = 255 - mDatareceive.mBuffer(i)
                mDatareceive.mBuffer(i) = temp
                strReceive = strReceive & Format(temp, "000") & ", "
                If i = 15 Then
                    strReceive = strReceive & Chr(10)
                End If
            Next
        Else
            LabelDataCompare.Caption = "读数据返回错误！返回数据长度" & mLength
            mblnStartCommunicate = True
            Exit Sub
        End If
    Else
        LabelDataCompare.Caption = "写数据返回错误！返回数据长度" & mLength
        mblnStartCommunicate = True
        Exit Sub
    End If
    
    For i = 1 To mDataLength
       If mDataSend.mBuffer(i) <> mDatareceive.mBuffer(i) Then
           blnDataCompareError = True
           Exit For
       End If
    Next
    TextReceive.Text = strReceive
    If blnDataCompareError = True Then
        LabelDataCompare.Caption = "第" & i & "个写入数据和读回数据不同！"
        mblnStartCommunicate = True
    Else
        LabelDataCompare.Caption = "写入数据和读回数据完全相同！"
        mblnStartCommunicate = False
    End If
    
End Sub

Private Sub Usb_Refresh()
    '设置设备插拔监视
    If (CH375SetDeviceNotify(mIndex, vbNullString, AddressOf iNotifyRoutine) = False) Then
       MsgBox "设置监视CH372/CH375设备插拔失败"
    End If
        
    mOpen = CH375OpenDevice(mIndex)                  '窗体加载时打开设备
    If mOpen = -1 Then
        Call pnpproce_KeyUp(CH375_DEVICE_REMOVE, 0)  '作设备拔出处理
        Exit Sub
    Else
        Call pnpproce_KeyUp(CH375_DEVICE_ARRIVAL, 0) '作设备插入处理
    End If
    Call CH375SetTimeout(mIndex, 100, 100)
    mblnStartCommunicate = True
End Sub


Private Sub Command3_Click()
    Call Usb_Refresh
End Sub

Private Sub Form_Load()
    HScrollDataLength.Enabled = True
    HScrollDataLength.Max = 64
    HScrollDataLength.Min = 1
    HScrollDataLength.Value = 30
    mDataLength = HScrollDataLength.Value
    LabelDataLength.Caption = mDataLength
    'TextSend.MultiLine = True
    'TextReceive.MultiLine = True
    mIndex = 0  '第一个ch375设备
    mShowLED = 0
    mKeyCode = &HFF
    mCaptionInform = " 信息提示 "
    mOpen = -1
    
    ' 设置USB数据读写的超时,超过3000mS未完成读写将强制返回,避免一直等待下去
    'Call CH375SetTimeout(mIndex, 30, 30)
    
    Call Usb_Refresh
    
    ' 以下测试PC机与单片机之间的USB通讯,仅作演示,本身没有意义
    'Call Testcommunication
    
    Call mCallInt  '设置中断
 '下面加载中断服务程序 , 中断服务程序是在应用层执行的, 其线程优先级是THREAD_PRIORITY_TIME_CRITICAL
 '当单片机有事需要通知计算机时 , 可以用CMD_WR_USB_DATA5命令写入中断特征数据, 计算机的mInterruptEvent线程将会收到该中断特征数据
 '然后mInterruptEvent线程向主程序发出消息进行处理,mInterruptEvent线程相当于中断服务程序,代替主程序定时查询单片机
    
End Sub

Private Sub HScrollDataLength_Change()
    mDataLength = HScrollDataLength.Value
    LabelDataLength.Caption = mDataLength
End Sub

Private Sub Form_Unload(Cancel As Integer)     '退出窗体
    CH375SetDeviceNotify mIndex, vbNullString, 0&    '取设备插拔通知
    CH375SetIntRoutine mIndex, 0&                    '取消中断上传
    CH375CloseDevice (mIndex)     '程序退出关闭设备
End Sub