frmmain.frm

上位机界面的设计和程序

      Index           =   1
      Left            =   1080
      TabIndex        =   1
      Top             =   120
      Width           =   595
   End
   Begin VB.CommandButton Command1 
      Caption         =   "0"
      Height          =   855
      Index           =   0
      Left            =   495
      TabIndex        =   0
      Top             =   120
      Width           =   595
   End
   Begin VB.Label devstatue 
      AutoSize        =   -1  'True
      Caption         =   "**"
      Height          =   540
      Left            =   1455
      TabIndex        =   75
      Top             =   5880
      Width           =   180
   End
   Begin VB.Label Label2 
      Caption         =   "下面的每个按钮对应按键，按下时同步显示"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   615
      TabIndex        =   10
      Top             =   1560
      Width           =   3855
   End
   Begin VB.Label Label1 
      Caption         =   "上面的每个按钮对应数码管，双击输入数字"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   615
      TabIndex        =   9
      Top             =   1200
      Width           =   3975
   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

'以下测试PC机与单片机之间的USB通讯
Public Sub Testcommunication()
    Dim mLength As Long
    Dim data As String
    Dim mBuffer As String
    mDemoReq.mCommandCode = DEF_CMD_TEST_DATA    ' 测试命令,将PC机发来的所有数据取反后返回
    mDemoReq.mCommandCodeNot = &HFF - DEF_CMD_TEST_DATA
    mDemoReq.mParameter(0) = &H5A  ' 任意的测试数据,返回后将按位取反
    mDemoReq.mParameter(1) = &H96  ' 任意的测试数据,返回后将按位取反
    mDemoReq.mParameter(2) = &HF3  ' 任意的测试数据,返回后将按位取反
    mDemoReq.mParameter(3) = &H4C  ' 任意的测试数据,返回后将按位取反
    mDemoReq.mParameter(4) = &H39  ' 任意的测试数据,返回后将按位取反

    mLength = CONST_CMD_LEN    ' 命令包的长度
    If (CH375Writedata(mIndex, mDemoReq, mLength)) Then       ' 通过CH375发送命令数据,成功
        mLength = mCH375_PACKET_LENGTH
        If (CH375ReadData(mIndex, mDemoReq, mLength)) Then        ' 通过CH375接收应答数据,成功
            If (mLength = CONST_CMD_LEN) Then
                If (mDemoReq.mCommandCode <> DEF_CMD_TEST_DATA) Then
                    MsgBox "通过USB传输的数据有错误", vbExclamation, mCaptionInform
                End If
            Else
                MsgBox "CH375数据测试返回的长度错误", vbExclamation, mCaptionInform
            End If
                  
        Else
            MsgBox "CH375ReadData 失败", vbExclamation, mCaptionInform
        End If
    Else
        MsgBox "CH375WriteData 失败", vbExclamation, mCaptionInform
    End If
        
' 下面是下传数据块的例子

            '  mBuffer(0) = data  ' 准备下传的数据
            '  mLength = mDownloadData(mBuffer, 4096)   ' 将数据块从计算机下传给单片机,返回实际传输长度
              mLength = mUploadData(mBuffer, 4096)     ' 从单片机上传数据块到计算机,返回实际传输长度

End Sub

'/*设备插拔事件处理*/
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
        devstatue.Caption = "**CH372/CH375设备已插上"
        
    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
        devstatue.Caption = "**CH372/CH375设备已拔出"
    End If
End Sub
Private Sub Command1_Click(index As Integer)
    Select Case index       '按钮标识
        Case 0
            frmEnter.index = 0                          '按钮1
        Case 1
            frmEnter.index = 1                          '按钮2
        Case 2
            frmEnter.index = 2                          '按钮3
        Case 3
            frmEnter.index = 3                          '按钮4
        Case 4
            frmEnter.index = 4                          '按钮5
        Case 5
            frmEnter.index = 5                          '按钮6
        Case 6
            frmEnter.index = 6                          '按钮7
        Case 7
            frmEnter.index = 7                          '按钮8
    End Select
    frmEnter.Show
End Sub

Private Sub Command3_Click()               '命令按钮
    frmEnter.index = -1                    '识别命令按钮
    frmEnter.Show vbModal, Me
 
End Sub



'模拟调用窗体的按键按下事件
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim mLength As Long
    Dim mDemoReq As COMMAND_PACKET
    If KeyCode = 1 Then     ' 键被按下,以下先释放原按键再读取新按键值
        Call mSyncKeyboard(&HFF)        ' 释放上次的按键
        Call mSyncKeyboard(mKeyCode)         '根据键值作同步显示
    End If
End Sub
'模拟调用窗体按键松开事件
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 1 Then
        Call mSyncKeyboard(&HFF)   ' 键盘按键松开
    End If
End Sub

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

'同步按键显示,键被按下时显示◎,否则显示键号
Sub mSyncKeyboard(ByVal iKeyCode As Long)     ' 输入的按键值,00H-3FH则键被按下,0FFH则按下的键被释放
' 以下方法只适用于IDC_K0至IDC_K63完全有序的情况
    Static mKeyNo As Long
    If iKeyCode = &HFF Then      ' 释放刚按下的键
         Command2(mKeyNo).Caption = CStr(mKeyNo)     '恢复显示键号
         
    Else                         ' 键被按下
        mKeyNo = iKeyCode And &H3F   ' 键号0-63
        Command2(mKeyNo).Caption = "◎"   ' 00H-3FH键被按下则显示◎
        
    End If
End Sub

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

Private Function mDownloadData(ByRef iBuffer As String, ByVal iLength As Long) As Long

    Dim mDemoReq   As COMMAND_PACKET
    Dim mLength As Long
    If (iLength > 4096) Then
    
        MsgBox "单次下传数据长度超过4096字节", vbExclamation, mCaptionInform
        mDownloadData = 0
        Exit Function
    End If
    mDemoReq.mCommandCode = DEF_CMD_DOWN_DATA  ' 连续下传数据块
    mDemoReq.mCommandCodeNot = &HFF - DEF_CMD_DOWN_DATA
    mDemoReq.mParameter(0) = ACCESS_MCS51_XRAM  ' 读写51单片机的外部RAM(本演示板的单片机没有外部RAM,所以无法演示)
    mDemoReq.mParameter(1) = &H0   ' 指定外部RAM缓冲区起始地址,该例是将数据下传到起始地址为0X8200的外部RAM
    mDemoReq.mParameter(2) = &H82
    mDemoReq.mParameter(3) = iLength  ' 传输数据总长度
    mLength = CONST_CMD_LEN    ' 命令包的长度
    If (CH375Writedata(mIndex, mDemoReq, mLength)) Then      ' 通过CH375发送命令包,成功
    
        mLength = iLength       ' 数据块的长度,一次下传不超过4096字节
        If ((mLength Mod 64) = CONST_CMD_LEN) Then
            mLength = mLength + 1  ' 防止数据包的长度与命令包的长度相同,如果相同,则多发送一个无效数据
        End If
        If (CH375Writedata(mIndex, iBuffer, mLength)) Then       ' 通过CH375发送数据,成功
            mDownloadData = mLength
            Return
        Else
            MsgBox "CH375WriteData 下传数据失败", vbExclamation, mCaptionInform
        End If
    Else
        MsgBox "CH375WriteData 发送命令失败,DEF_CMD_DOWN_DATA", vbExclamation, mCaptionInform
    End If
    mDownloadData = 0
    Return
End Function

Private Function mUploadData(ByRef iBuffer As String, ByVal iLength As Long) As Long
    Dim mDemoReq As COMMAND_PACKET
    Dim mLength As Long
    Dim oBuffer As String
    If (iLength > 4096) Then
    
        MsgBox "单次上传数据长度超过4096字节", vbQuestion, mCaptionInform
        mUploadData = 0
        Return
    End If
'    mDemoReq.mCommandCode = DEF_CMD_CLEAR_UP    ' 连续上传数据块之前进行同步,实际是让单片机清除上传缓冲区的已有内容
'    mDemoReq.mCommandCodeNot = &HFF - DEF_CMD_CLEAR_UP
'    mLength = CONST_CMD_LEN    ' 命令包的长度
'    If (CH375Writedata(mIndex, mDemoReq, mLength)) Then       ' 通过CH375发送命令包,成功
    
        mDemoReq.mCommandCode = DEF_CMD_UP_DATA     ' 连续上传数据块
        mDemoReq.mCommandCodeNot = &HFF - DEF_CMD_UP_DATA
'        mDemoReq.mParameter(0) = ACCESS_MCS51_XRAM      ' 读写51单片机的外部RAM(本演示板的单片机没有外部RAM,所以无法演示)
'        mDemoReq.mParameter(1) = &H8200         ' 指定外部RAM缓冲区起始地址,该例是将从起始地址为0X8200的外部RAM上传数据
'        mDemoReq.mParameter(3) = iLength  ' 传输数据总长度
'        mLength = CONST_CMD_LEN     '命令包的长度
  '      If (CH375Writedata(mIndex, mDemoReq, mLength)) Then        ' 通过CH375发送命令包,成功
        
            mLength = 64   ' 数据块的长度,一次上传不超过4096字节
            If (CH375ReadData(mIndex, oBuffer, mLength)) Then        ' 通过CH375接收数据,成功
                iLength = mLength
                Return
            Else
                MsgBox "CH375ReadData 上传数据失败", vbExclamation, mCaptionInform
            End If
        
      '  Else
       '     MsgBox "CH375WriteData 发送命令失败,DEF_CMD_UP_DATA", vbExclamation, mCaptionInform
      '  End If
            
    
   ' Else
   '     MsgBox "CH375WriteData 发送命令失败,DEF_CMD_CLEAR_UP", vbExclamation, mCaptionInform
   ' End If
    mUploadData = 0
    Return
End Function