frmmain.frm

上位机界面的设计和程序

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "Form1"
   ClientHeight    =   5235
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9360
   LinkTopic       =   "Form1"
   ScaleHeight     =   5235
   ScaleWidth      =   9360
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text4 
      Height          =   615
      Left            =   1680
      TabIndex        =   6
      Top             =   4560
      Width           =   1215
   End
   Begin VB.TextBox Text3 
      Height          =   495
      Left            =   240
      TabIndex        =   5
      Top             =   4560
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始检测"
      Height          =   495
      Left            =   3240
      TabIndex        =   4
      Top             =   4560
      Width           =   3495
   End
   Begin VB.TextBox Text2 
      Height          =   4095
      Left            =   4920
      TabIndex        =   3
      Top             =   120
      Width           =   5295
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   2760
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00C0C0FF&
      Height          =   3495
      Left            =   960
      ScaleHeight     =   3435
      ScaleWidth      =   3675
      TabIndex        =   0
      Top             =   720
      Width           =   3735
   End
   Begin VB.Label Label1 
      Caption         =   "光照强度："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   960
      TabIndex        =   2
      Top             =   240
      Width           =   1575
   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 datamary As String
Dim datalong As Long
Dim mCaptionInform As String
Dim mdemoreq As COMMAND_PACKET
Dim mOpen As Long
Dim iBuffer As String
Dim iLength As Long
Dim average As Long
Dim obuffer As String
'Dim iNotifyRoutine As Long
Dim ioLength As Long
Dim iIndex As Long
Private Sub Command1_Click()
    Dim mLength As Long
    Dim ioLength As Long
    Dim iIndex As Long
    Dim mdemoreq As String
    Dim obuffer As String
  ' 以下测试PC机与单片机之间的USB通讯
    Call Testcommunication
    '通讯正常后开始上传数据
  '  Do While True
   '   If (mUploadData(iBuffer, iLength) <> 0) Then    '通过CH375接收数据,成功
       ioLength = mCH375_PACKET_LENGTH
       If (CH375ReadData(iIndex, obuffer, ioLength)) Then
      '  datamary = mdemoreq
         datamary = obuffer
        'Text2.Text = datamary
       ' datalong = iLength \ 8
        'Call pressdata(average)
        'Text1.Text = average
        'Call display
      Else
        MsgBox "CH375ReadData 上传数据失败", vbExclamation, mCaptionInform
      
      End If
 '   Loop
    
 ' Call mCallInt  '设置中断
 '下面加载中断服务程序 , 中断服务程序是在应用层执行的, 其线程优先级是THREAD_PRIORITY_TIME_CRITICAL
 '当单片机有事需要通知计算机时 , 可以用CMD_WR_USB_DATA5命令写入中断特征数据, 计算机的mInterruptEvent线程将会收到该中断特征数据
 '然后mInterruptEvent线程向主程序发出消息进行处理,mInterruptEvent线程相当于中断服务程序,代替主程序定时查询单片机
  
End Sub

'Const DEMO_GET_KEY = &H34
'Const DEMO_RET_OK = &H0
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 cheakline(CH375_DEVICE_REMOVE)          '作设备拔出处理
        Exit Sub
    Else
        Call cheakline(CH375_DEVICE_ARRIVAL)          '作设备插入处理
    End If
    
    ' 设置USB数据读写的超时,超过3000mS未完成读写将强制返回,避免一直等待下去
    CH375SetTimeout mIndex, 3000, 3000
    
    ' 以下测试PC机与单片机之间的USB通讯
    'Call Testcommunication
    '通讯正常后开始上传数据
   ' Do While True
    '  If (mUploadData(iBuffer, iLength) <> 0) Then    '通过CH375接收数据,成功
   '     datamary = iBuffer
   '     Text2.Text = datamary
   '     datalong = iLength \ 8
   '     Call pressdata(average)
   '     Text1.Text = average
   '     Call display
   '   Else
   '     MsgBox "CH375ReadData 上传数据失败", vbExclamation, mCaptionInform
      
   '   End If
   ' Loop
    
 ' Call mCallInt  '设置中断
 '下面加载中断服务程序 , 中断服务程序是在应用层执行的, 其线程优先级是THREAD_PRIORITY_TIME_CRITICAL
 '当单片机有事需要通知计算机时 , 可以用CMD_WR_USB_DATA5命令写入中断特征数据, 计算机的mInterruptEvent线程将会收到该中断特征数据
 '然后mInterruptEvent线程向主程序发出消息进行处理,mInterruptEvent线程相当于中断服务程序,代替主程序定时查询单片机
  
       
End Sub
Private Function display()
Dim pw, ph
Dim zi, sr As Single
Picture1.Cls
sr = Val(Text1.Text)
If sr >= 50 Then
   MsgBox "请输入一个合理的温度", vbYesNo, "温度考虑"
   Text1.Text = ""
   Text1.SetFocus
Else
zi = sr * 20
Picture1.Width = 4320: Picture1.Height = 2880
'Picture1.BackColor = QBColor(9) '将picture1背景设置为白色
Picture1.FillStyle = vbFSSolid
Picture1.FillColor = QBColor(Int(12))
pw = Picture1.ScaleWidth / 2
ph = Picture1.ScaleHeight / 2
Picture1.Circle (Int(pw), Int(ph)), zi
End If
End Function





'以下测试PC机与单片机之间的USB通讯
Public Function Testcommunication()
    Dim obuffer As String
    Dim mLength As Long
    Dim xieyi As Long
    Dim xieyiback As String
     mdemoreq.mCommandCode = DEF_CMD_TEST_DATA           '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发送命令数据,成功
      '  xieyi = mdemoreq
        mLength = 64
        If (CH375ReadData(mIndex, mdemoreq, mLength)) Then    ' 通过CH375接收应答数据,成功
       '  If (CH375ReadData(iIndex, obuffer, mLength)) Then
           ' xieyiback = obuffer
                
           
            mLength = 64
            If (CH375ReadData(mIndex, mdemoreq, mLength)) Then
               Text1.Text = mdemoreq.mCommandCode
               Text3.Text = mdemoreq.mCommandCodeNot
               Text4.Text = mdemoreq.mParameter(0)
               
         '   End If
         '   mLength = 64
          '  If (CH375ReadData(mIndex, mdemoreq, mLength)) Then
         '      Text3.Text = mdemoreq.mCommandCode
         '   End If
        '    mLength = 64
         '   If (CH375ReadData(mIndex, mdemoreq, mLength)) Then
        '       Text4.Text = mdemoreq.mCommandCode
               End If
            
         '   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
        
' 下面是下传数据块的例子

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

End Function
'/*设备插拔事件处理*/
Private Sub cheakline(iEventatus)
    Dim i As Byte
    Dim iEventStatus As Long
    iEventStatus = 3   '插拔事件代码

    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
       
       
   ElseIf (iEventStatus = CH375_DEVICE_REMOVE) Then
    
        If (mOpen <> -1) Then
            CH375CloseDevice (mIndex)     '设备拔出,关闭设备句柄
            mOpen = -1
        End If
    End If
End Sub

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


'最好采用每次只发送8位，并且添加标志用来区别数据来源和分离数据
Private Function pressdata(ByVal average As Long)
    Dim data() As String
    Dim i As Long
    If (datalong = 3) Then
       For i = 1 To 3
    '    data(1) = datamary
    '    data(2) = datamary
    '    data(3) = datamary
         data(i) = datamary
         Next i
       Else
         MsgBox "CH375ReadData 上传数据长度出错", vbExclamation, mCaptionInform
    End If
        average = CInt(data(1))
        Return
End Function