frmmain.frm

VB写的串口通讯,通过串口对单片机进行控制.

'*************************************************************************
'**串行信号约定：
'**  FORWARD:       &H0
'**  BACKWARD:      &H1
'**  LEFT_TURN:     &H2
'**  RIGHT_TURN:    &H3
'**  SPEED_DOUBLE:  &H4
'**  SPEED_HALVE:   &H5
'**  DEFAULT_SPEED: &H6
'**  SPEED_ZERO:    &H7
'**  GO_LEFT_CIRCLE:&H8
'**  GO_RIGHT_CIRCLE:&H9
'**  其他暂未定义
'**
'*************************************************************************
Option Explicit
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'*************************************************************************
'**功能描述：清空数据区
'*************************************************************************
Private Sub cmd_ClearTxtMsg_Click()
    txtMsg.Text = ""
End Sub

'*************************************************************************
'**功能描述：前进
'*************************************************************************
Private Sub cmd_Forward_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H0         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：后退
'*************************************************************************
Private Sub cmd_Backward_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H1         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：左转
'*************************************************************************
Private Sub cmd_Left_Turn_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H2         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：右转
'*************************************************************************
Private Sub cmd_Right_Turn_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H3         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：速度加倍
'*************************************************************************
Private Sub cmd_Speed_Double_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H4         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：速度减半
'*************************************************************************
Private Sub cmd_Speed_Halve_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H5         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：数据恢复至Default
'*************************************************************************
Private Sub cmd_Default_Speed_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H6         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：停止
'*************************************************************************
Private Sub cmd_Speed_Zero_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H7         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：走左圆
'*************************************************************************
Private Sub cmd_Go_Left_Circle_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H8         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：走右圆
'*************************************************************************
Private Sub cmd_Go_Right_Circle_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &H9         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：走8字    预留功能，尚未完成
'*************************************************************************
Private Sub cmd_Go8Figure_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &HA         '数据
  SendData bytData, 1      '发送命令
End Sub

'*************************************************************************
'**功能描述：走正方形    预留功能，尚未完成
'*************************************************************************
Private Sub cmd_GoSquareFigure_Click()
  ReDim bytData(1) As Byte
  bytData(0) = &HA         '数据
  SendData bytData, 1      '发送命令
End Sub


'*************************************************************************
'**功能描述：串口初始化
'*************************************************************************
Private Sub Form_Load()
   OpenPort 1            '打开串口
End Sub

'*************************************************************************
'**函 数 名：OpenPort
'**输    入：PortNo(Integer)                       - 串口号 1，2，3...
'**        ：Optional InBufferSize(Integer = 1024) - 接收缓冲区  默认为1024个字节
'**        ：Optional OutBufferSize(Integer = 512) - 发送缓冲区  默认为512个字节
'**输    出：0 打开串口成功 1 打开串口失败
'**功能描述：打开串口
'*************************************************************************
Public Function OpenPort(PortNo As Integer, Optional InBufferSize As Integer = 1024, Optional OutBufferSize As Integer = 512) As Long
   On Error GoTo ErrExit
    MSComm1.CommPort = PortNo                   '采用COM端口
    MSComm1.Settings = "600,n,8,1"
    MSComm1.InputMode = comInputModeBinary      '采用二进制传输
    MSComm1.NullDiscard = False                 'NULL字符从端口传送到接受缓冲区
    MSComm1.DTREnable = False                   'DTR线无效
    MSComm1.EOFEnable = False                   '不寻找EOF符
    MSComm1.RTSEnable = False                   'RTS线无效
    MSComm1.InBufferCount = 0                   '清空接受缓冲区
    MSComm1.OutBufferCount = 0                  '清空传输缓冲区
    MSComm1.SThreshold = 1                      '如果传输缓冲区完全空时产生MSComm事件
    MSComm1.RThreshold = 0                      '不产生MSComm事件
    MSComm1.InBufferSize = InBufferSize         '接收缓冲区  默认为1024个字节
    MSComm1.OutBufferSize = OutBufferSize       '发送缓冲区  默认为512个字节
    MSComm1.PortOpen = True                     '打开端口
    OpenPort = 0
   Exit Function
ErrExit:
   OpenPort = 1
End Function

'*************************************************************************
'**函 数 名：SendData
'**输    入：bytData()(byte) - 数据数组
'**        ：bytNum(byte)    - 数据个数(1～256/数据类型的长度)
'**输    出：(Long) - 0 成功 1 －超时 2 - 其它未知错误
'**功能描述：发送数据
'*************************************************************************
Public Function SendData(bytData() As Byte, Optional bytNum As Byte = 1) As Long
    On Error GoTo ErrExit

    Dim bytSendArray() As Byte                     '发送数据缓冲区
    Dim intGetDataLen As Integer                   '要接收的数据长度
    Dim sngTimeSpace As Single                     '延时时间
    Dim sngTime As Single
    Dim bytReceiveArray() As Byte                  '接收的数据
    Dim VarReceiveData As Variant                  '接收的变体数据

    Dim i As Long

    ReDim bytSendArray(0 To bytNum - 1) As Byte '发送数据缓冲区

    '数据
    For i = 0 To bytNum - 1
        bytSendArray(i) = bytData(i)
    Next

    '=====================================================================================
    '信息发送
    '=====================================================================================
    MSComm1.InBufferCount = 0                      '清空接收缓冲区
    MSComm1.Output = bytSendArray                  '发送数据

    Do
        DoEvents
    Loop Until MSComm1.OutBufferCount = 0          '等待，直到数据发送完毕

    '=====================================================================================
    '信息接收
    '=====================================================================================

    '设定要接收的数据长度
    intGetDataLen = 1
    SendData = 0

    '超时时间计算:字节数×每个字节的传输时间×10             波特率为600
    sngTimeSpace = intGetDataLen * (11000# / 600#) * 10#

    sngTime = GetCurrentTime()                          '

    Do While True                                  '数据接收

        DoEvents

        If MSComm1.InBufferCount >= intGetDataLen Then Exit Do

        '超时处理
'        If Abs(GetCurrentTime() - sngTime) > sngTimeSpace Then    '超时
'           SendData = 1
'           Exit Function
'       End If

    Loop

    VarReceiveData = MSComm1.Input
    bytReceiveArray = VarReceiveData

Exit Function

ErrExit:
    SendData = 2
End Function

'*************************************************************************
'**功能描述：关闭串口
'*************************************************************************
Public Sub ClosePort()
   On Error GoTo ErrExit
     MSComm1.PortOpen = False                      '关闭端口
   Exit Sub
ErrExit:
End Sub

'*************************************************************************
'**功能描述：结束处理
'*************************************************************************
Private Sub Form_Unload(Cancel As Integer)
   ClosePort  '关闭串口
End Sub

'*************************************************************************
'**功能描述：链接点击
'*************************************************************************
Private Sub label5_Click()
Call ShellExecute(frmMain.hwnd, "open", "http://blog.icfans.com", vbNullString, vbNullString, &H0)
End Sub