sericomm.frm

一个用VB编写的串口通信程序

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form sericomm 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "串口通信"
   ClientHeight    =   1290
   ClientLeft      =   11505
   ClientTop       =   3015
   ClientWidth     =   2265
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1290
   ScaleWidth      =   2265
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton serictrlbtn 
      Caption         =   "打开串口"
      Height          =   435
      Left            =   540
      TabIndex        =   0
      Top             =   660
      Width           =   1095
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   1680
      Top             =   660
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      OutBufferSize   =   1024
      RThreshold      =   4
      BaudRate        =   110
      SThreshold      =   2
   End
   Begin VB.Shape greenlight 
      BorderColor     =   &H0000FF00&
      FillColor       =   &H0000FF00&
      FillStyle       =   0  'Solid
      Height          =   375
      Left            =   840
      Shape           =   3  'Circle
      Top             =   120
      Width           =   495
   End
   Begin VB.Shape redlight 
      BorderColor     =   &H000000FF&
      FillColor       =   &H000000FF&
      FillStyle       =   0  'Solid
      Height          =   375
      Left            =   840
      Shape           =   3  'Circle
      Top             =   120
      Width           =   495
   End
End
Attribute VB_Name = "sericomm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long


Private Sub Form_Load()
retvalue = SetWindowPos(Me.hwnd, -1, Me.CurrentX, Me.CurrentY, 150, 110, &H40)
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

End Sub

Private Sub Form_Unload(Cancel As Integer)
If controllor.state = False Then
    Cancel = 0
Else
    Me.Visible = False
    Cancel = 1
End If
End Sub

Private Sub MSComm1_OnComm()
Dim Buffercount As Integer
Dim tempdata As Variant
Dim temp As Variant
Dim det As Single

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''串口通信功能子程序'''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Select Case MSComm1.CommEvent
              Case comEvReceive    '收到数据事件
 '''''''''''''''''''''''''''''''''''''''''''''''''''''
        realtime = (Timer - starttime) * 1000     '计算实时时钟
        
        If seriauto = True And Viewer.receiveonly <> 1 Then
'/////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////
'////////////////////////即收又发///////////////////////////////////////////
            If MSComm1.InBufferCount >= 4 And MSComm1.InBufferCount Mod 2 = 0 Then
              Buffercount = (MSComm1.InBufferCount) / 2 - 1 '检查缓冲区内长度，按16位数列出
              MSComm1.InputLen = 2                       '重设读取长度，用于一次将缓冲区清空
              ReDim tempdata(0 To Buffercount - 1) As Variant
              For i = 0 To Buffercount - 1
              tempdata(i) = MSComm1.Input               '读取缓冲区
              Next i
            
              det = (realtime - pretime_in) / Buffercount  '计算时间差，为计算时间做准备

 '''''''''''''''''''''''''''''''''''''''''''''''''''''
              For i = 1 To Buffercount               '通过循环将每一个数据存入数组并对时间赋值
              datapointer_in = Fix(pretime_in + det * i)      '修改指针
                If datapointer_in >= 32000 Then
                 GoTo mark2::
                End If
              
              indata(datapointer_in, 1) = Fix(pretime_in + det * i)
              indata(datapointer_in, 2) = tempdata(i - 1)(0) * 256 + tempdata(i - 1)(1)
              
                                                        '将其写入文件
              Print #1, indata(datapointer_in, 1), indata(datapointer_in, 2)
              Next i
 '''''''''''''''''''''''''''''''''''''''''''''''''''''
              pretime_in = realtime                        '修改时间记录，完成读数
              If datapoiinter_in >= 32000 Then
              
mark2::
                    Call serictrlbtn_Click                  '30秒溢出中断
              End If
            End If
'/////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////
'////////////////////////只收不发///////////////////////////////////////////
            ElseIf seriauto = True And Viewer.receiveonly = 1 Then
                If MSComm1.InBufferCount >= 4 And MSComm1.InBufferCount Mod 2 = 0 Then
                    Do While MSComm1.InBufferCount > 2
                        temp = MSComm1.Input
                        Print #1, realtime, temp(0) * 256 + temp(1)
                    Loop
                    
                    temp = MSComm1.Input
                    
                    datapointer_in = datapointer_in + 1
                    indata(datapointer_in, 1) = realtime
                    indata(datapointer_in, 2) = temp(0) * 256 + temp(1)
                    Call Viewer.drawdata
                    
                    If datapointer_iin >= 32000 Then
                    Call serictrlbtn_Click                  '30秒溢出中断
                    End If
          Else
'/////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////
'////////////////////////手动方式///////////////////////////////////////////
          
            If controllor.send.Enabled = False Then
                MSComm1.InputLen = 1
                MSComm1.InputMode = comInputModeText
                temp = MSComm1.Input
                If temp = "!" Then
                    controllor.send.Enabled = True
                 MSComm1.InputMode = comInputModeBinary
                End If
            Else
               If MSComm1.InBufferCount Mod 2 = 0 Then
              Buffercount = MSComm1.InBufferCount / 2   '检查缓冲区内长度，按16位数列出
              MSComm1.InputLen = MSComm1.InBufferCount  '重设读取长度，用于一次将缓冲区清空
              tempdata = MSComm1.Input                  '读取缓冲区
              
              det = (realtime - pretime_in) / Buffercount  '计算时间差，为计算时间做准备
 '''''''''''''''''''''''''''''''''''''''''''''''''''''
              For i = 0 To Buffercount - 1              '通过循环将每一个数据存入数组并对时间赋值
              datapointer_in = datapointer_in + 1       '修改指针
              
              controllor.intext.Text = controllor.intext.Text + CStr(Fix(pretime_in + det * i)) + "  "
              controllor.intext.Text = controllor.intext.Text + CStr(tempdata(2 * i) * 256 + tempdata(2 * i + 1)) + "   "
              Next i
             End If
            End If
         pretime_in = realtime
         End If

 '''''''''''''''''''''''''''''''''''''''''''''''''''''


              Case Else
           End Select

End Sub

Public Sub serictrlbtn_Click()
If serictrlbtn.Caption = "打开串口" And MSComm1.PortOpen = False Then

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''初始化串口控件各设置'''''''''''''''''''''''''''''
    MSComm1.Settings = "19200,N,8,1"
    MSComm1.OutBufferCount = 0
    MSComm1.InBufferCount = 0
    MSComm1.InputLen = 1
    MSComm1.InputMode = comInputModeBinary
'''''''''''''''''''''''''''''''''''''''''''''''''''''
    serictrlbtn.Caption = "关闭串口"
    greenlight.Visible = False
    redlight.Visible = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''
If seriauto = True And Viewer.receiveonly.Value = 1 Then
    For i = 0 To 32767
     indata(i, 2) = -1
    Next i
    Open "d:\indata.dat" For Output As #1
    MSComm1.PortOpen = True
'////////////////////////////////////////////与下位机握手
    MSComm1.InputMode = comInputModeText
    MSComm1.output = "?"
    Do While temp <> "!"
  
        temp = MSComm1.Input
    Loop
    MSComm1.OutBufferCount = 0
    MSComm1.InBufferCount = 0
    MSComm1.InputMode = comInputModeBinary
    Call initialvariable    '初始化各变量，为写数做准备
    MSComm1.InputLen = 2
Else
    MSComm1.PortOpen = True
    MSComm1.output = "?"
End If
    starttime = Timer       '串口开始工作
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf serictrlbtn.Caption = "关闭串口" And MSComm1.PortOpen = True Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
    Call stopvariable       '停止串口工作
    MSComm1.PortOpen = False
    Close #1
'''''''''''''''''''''''''''''''''''''''''''''''''''''
    serictrlbtn.Caption = "打开串口"
    greenlight.Visible = True
    redlight.Visible = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
End Sub