Serial.frm
上传用户:huaweixt1
上传日期:2013-04-14
资源大小:25k
文件大小:13k
- VERSION 5.00
- Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
- Begin VB.Form SerialFrm
- BorderStyle = 1 'Fixed Single
- Caption = "串口调试程序"
- ClientHeight = 5265
- ClientLeft = 45
- ClientTop = 435
- ClientWidth = 9780
- BeginProperty Font
- Name = "宋体"
- Size = 10.5
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Icon = "Serial.frx":0000
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 5265
- ScaleWidth = 9780
- StartUpPosition = 2 'CenterScreen
- Begin VB.TextBox chsum
- Height = 375
- Left = 9120
- TabIndex = 13
- Top = 4800
- Width = 615
- End
- Begin VB.Timer Timer1
- Left = 4800
- Top = 3000
- End
- Begin VB.Frame Frame1
- Height = 700
- Left = 120
- TabIndex = 3
- Top = 3960
- Width = 9615
- Begin VB.CheckBox ckOpenClose
- Caption = "开启串口"
- Height = 375
- Left = 120
- TabIndex = 12
- Top = 240
- Width = 1215
- End
- Begin VB.TextBox KeepSec
- Height = 350
- Left = 3240
- MaxLength = 5
- TabIndex = 10
- Top = 220
- Width = 1215
- End
- Begin VB.CheckBox ckAuto
- Caption = "自动发送"
- Height = 375
- Left = 1440
- TabIndex = 8
- Top = 220
- Width = 1215
- End
- Begin VB.ComboBox ComBaud
- Height = 330
- ItemData = "Serial.frx":0442
- Left = 8040
- List = "Serial.frx":044C
- Style = 2 'Dropdown List
- TabIndex = 7
- Top = 240
- Width = 1335
- End
- Begin VB.ComboBox ComPort
- Height = 330
- ItemData = "Serial.frx":045D
- Left = 6000
- List = "Serial.frx":047F
- Style = 2 'Dropdown List
- TabIndex = 5
- Top = 240
- Width = 1215
- End
- Begin VB.Label Label4
- BackStyle = 0 'Transparent
- Caption = "毫秒"
- Height = 255
- Left = 4560
- TabIndex = 11
- Top = 300
- Width = 495
- End
- Begin VB.Label Label3
- BackStyle = 0 'Transparent
- Caption = "间隔"
- Height = 255
- Left = 2760
- TabIndex = 9
- Top = 300
- Width = 495
- End
- Begin VB.Label Label2
- BackStyle = 0 'Transparent
- Caption = "波特率"
- Height = 255
- Left = 7320
- TabIndex = 6
- Top = 285
- Width = 735
- End
- Begin VB.Label Label1
- BackStyle = 0 'Transparent
- Caption = "串 口"
- Height = 255
- Left = 5160
- TabIndex = 4
- Top = 300
- Width = 855
- End
- End
- Begin MSCommLib.MSComm MSComm1
- Left = 6360
- Top = 2400
- _ExtentX = 1005
- _ExtentY = 1005
- _Version = 393216
- DTREnable = -1 'True
- End
- Begin VB.CommandButton sendBtn
- Caption = "发送"
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 240
- TabIndex = 2
- Top = 4800
- Width = 975
- End
- Begin VB.TextBox txtSend
- Height = 375
- Left = 1320
- TabIndex = 1
- Top = 4800
- Width = 7695
- End
- Begin VB.TextBox txtRecieve
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 3855
- Left = 120
- MultiLine = -1 'True
- ScrollBars = 2 'Vertical
- TabIndex = 0
- Top = 120
- Width = 9615
- End
- End
- Attribute VB_Name = "SerialFrm"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Dim setting As String
- Dim sendByte As Byte
- Dim sendStart As Boolean
- Dim temStr As String
- Dim firstByte(0) As Byte
- Dim sendBytes() As Byte
- Dim sendCount As Integer
- Dim getBytes() As Byte
- Dim getLen As Integer
- Dim tmpi As Integer
- Dim checkSum As Byte
- Private Sub ckAuto_Click()
- If ckAuto.Value = 1 Then
- If KeepSec.Text = "" Then
- KeepSec.Text = 0
- Exit Sub
- End If
- Timer1.Interval = KeepSec
- Else
- Timer1.Interval = 0
- End If
- End Sub
- Private Sub ckOpenClose_Click()
-
- On Error GoTo errStr
- If ckOpenClose.Value = 1 Then
- setting = ComBaud.Text & ",N,8,1"
- MSComm1.CommPort = ComPort.ListIndex + 1
- MSComm1.Settings = setting
- MSComm1.InputMode = comInputModeBinary
- MSComm1.Handshaking = comNone
- MSComm1.OutBufferSize = 1024
- MSComm1.InBufferSize = 512
- MSComm1.InputLen = 0
- MSComm1.SThreshold = 1
- MSComm1.RThreshold = 1
- If Not MSComm1.PortOpen Then
- MSComm1.PortOpen = True
- End If
- Else
- If MSComm1.PortOpen Then
- MSComm1.PortOpen = False
- End If
- End If
- Exit Sub
- errStr:
- If Err.Number = 8002 Then
- MsgBox "串口不存在!", vbOKOnly Or vbInformation
- ElseIf Err.Number = 8005 Then
- MsgBox "串口已打开!", vbOKOnly Or vbInformation
- End If
- ckOpenClose.Value = 0
- End Sub
- Private Sub ComPort_Click()
- If ckOpenClose.Value = 1 Then
- If MSComm1.PortOpen Then
- MSComm1.PortOpen = False
- End If
- setting = ComBaud.Text & ",N,8,1"
- MSComm1.CommPort = ComPort.ListIndex + 1
- MSComm1.Settings = setting
- MSComm1.InputMode = comInputModeBinary
- MSComm1.Handshaking = comNone
- MSComm1.OutBufferSize = 1024
- MSComm1.InBufferSize = 512
- MSComm1.InputLen = 0
- MSComm1.SThreshold = 1
- MSComm1.RThreshold = 1
- If Not MSComm1.PortOpen Then
- MSComm1.PortOpen = True
- End If
- End If
- End Sub
- Private Sub Form_Load()
- ComPort.ListIndex = 0
- ComBaud.ListIndex = 0
- sendStart = True
- Me.BackColor = RGB(150, 183, 208)
- Frame1.BackColor = RGB(150, 183, 208)
- ckOpenClose.BackColor = RGB(150, 183, 208)
- ckAuto.BackColor = RGB(150, 183, 208)
- End Sub
- Private Sub KeepSec_Change()
- If KeepSec.Text = "" Then
- Exit Sub
- End If
- If InStr("0123456789", Right(KeepSec.Text, 1)) <= 0 Then
- KeepSec.Text = Left(KeepSec.Text, Len(KeepSec.Text) - 1)
- KeepSec.SelStart = Len(KeepSec.Text)
- End If
- If (Left(KeepSec.Text, 1) = 0) And Len(KeepSec.Text) > 1 Then
- KeepSec.Text = Right(KeepSec.Text, Len(KeepSec.Text) - 1)
- KeepSec.SelStart = Len(KeepSec.Text)
- End If
- If (ckAuto.Value = 1) And (Val(KeepSec.Text) > 0) Then
- Timer1.Interval = KeepSec
- End If
- End Sub
- Private Sub MSComm1_OnComm()
- Select Case MSComm1.CommEvent
- ' Handle each event or error by placing
- ' code below each case statement
- ' 错误
- Case comEventBreak ' 收到 Break。
- Case comEventCDTO ' CD (RLSD) 超时。
- Case comEventCTSTO ' CTS Timeout。
- Case comEventDSRTO ' DSR Timeout。
- Case comEventFrame ' Framing Error
- Case comEventOverrun '数据丢失。
- Case comEventRxOver '接收缓冲区溢出。
- Case comEventRxParity ' Parity 错误。
- Case comEventTxFull '传输缓冲区已满。
- Case comEventDCB '获取 DCB] 时意外错误
- ' 事件
- Case comEvCD ' CD 线状态变化。
- Case comEvCTS ' CTS 线状态变化。
- Case comEvDSR ' DSR 线状态变化。
- Case comEvRing ' Ring Indicator 变化。
- Case comEvReceive ' 收到 RThreshold # ofchars.
-
- getLen = MSComm1.InBufferCount
- getBytes = MSComm1.Input
- For tmpi = 0 To getLen - 1
- txtRecieve.Text = Trim(txtRecieve.Text) & " " & IIf(Len(Hex$(getBytes(tmpi))) > 1, Hex$(getBytes(tmpi)), "0" & Hex$(getBytes(tmpi)))
- Next tmpi
- Case comEvSend ' 传输缓冲区有 Sthreshold 个字符 '
- Case comEvEOF ' 输入数据流中发现 EOF 字符
- End Select
- End Sub
- Private Sub sendBtn_Click()
- If Not MSComm1.PortOpen Then
- MsgBox "串口没有打开!", vbOKOnly Or vbInformation, "提示信息"
- Timer1.Interval = 0
- ckAuto.Value = 0
- Exit Sub
- End If
- If Trim(txtSend.Text) = "" Then
- Exit Sub
- End If
- checkSum = 0
- txtSend.Text = Trim(txtSend.Text)
- If Len(Trim(Right(txtSend.Text, 2))) < 2 Then
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1) & "0" & Right(txtSend.Text, 1)
- End If
- ReDim sendBytes(0 To (Len(Trim(txtSend.Text)) - 1) / 3)
- For sendCount = 0 To (Len(Trim(txtSend.Text)) - 1) / 3
- sendBytes(sendCount) = Val("&H" & Mid(txtSend.Text, sendCount * 3 + 1, 2))
- Next sendCount
- chsum.Text = Hex$(checkSum)
- MSComm1.Output = sendBytes
- End Sub
- Private Sub Timer1_Timer()
- Call sendBtn_Click
- End Sub
- Private Sub txtSend_Change()
-
- If txtSend.Text = "" Then
- Exit Sub
- End If
- If InStr("0123456789abcedfABCDEF ", Right(txtSend.Text, 1)) <= 0 Then
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1)
- txtSend.SelStart = Len(txtSend.Text)
- End If
- Select Case Right(txtSend.Text, 1)
- Case "a"
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1) & "A"
- txtSend.SelStart = Len(txtSend.Text)
- Case "b"
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1) & "B"
- txtSend.SelStart = Len(txtSend.Text)
-
- Case "c"
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1) & "C"
- txtSend.SelStart = Len(txtSend.Text)
-
- Case "d"
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1) & "D"
- txtSend.SelStart = Len(txtSend.Text)
- Case "e"
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1) & "E"
- txtSend.SelStart = Len(txtSend.Text)
- Case "f"
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1) & "F"
- txtSend.SelStart = Len(txtSend.Text)
- End Select
-
- ' If (Left(txtSend.Text, 1) = 0) And Len(txtSend.Text) > 1 Then
- ' txtSend.Text = Right(txtSend.Text, Len(txtSend.Text) - 1)
- ' txtSend.SelStart = Len(txtSend.Text)
- ' End If
- If Right(txtSend.Text, 2) = " " Then
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 1)
- txtSend.SelStart = Len(txtSend.Text)
- Exit Sub
- End If
- If Len(txtSend.Text) < 2 Then
- Exit Sub
- End If
- If Right(txtSend.Text, 1) = " " Then
- If Len(txtSend.Text) = 2 Then
- txtSend.Text = "0" & txtSend.Text
- txtSend.SelStart = Len(txtSend.Text)
- Exit Sub
- End If
- If Len(Trim(Mid(txtSend.Text, Len(txtSend.Text) - 2, 2))) < 2 Then
- temStr = "0" & Mid(txtSend.Text, Len(txtSend.Text) - 1, 1) & " "
- txtSend.Text = Left(txtSend.Text, Len(txtSend.Text) - 2) & temStr
- txtSend.SelStart = Len(txtSend.Text)
- End If
- End If
- If Len(txtSend.Text) < 3 Then
- Exit Sub
- End If
- If Len(Trim(Right(txtSend.Text, 3))) > 2 Then
- txtSend.Text = Trim(Left(txtSend.Text, Len(txtSend.Text) - 1)) & " " & Right(txtSend.Text, 1)
- txtSend.SelStart = Len(txtSend.Text)
- End If
-
- End Sub