form1.vb

VB开发的串口调试程序,VB开发的串口调试程序

		Me.Label7.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label7.UseMnemonic = True
		Me.Label7.Visible = True
		Me.Label7.AutoSize = False
		Me.Label7.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label7.Name = "Label7"
		Me.Label6.Text = "串口指示灯"
		Me.Label6.Size = New System.Drawing.Size(61, 13)
		Me.Label6.Location = New System.Drawing.Point(376, 12)
		Me.Label6.TabIndex = 16
		Me.Label6.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label6.BackColor = System.Drawing.SystemColors.Control
		Me.Label6.Enabled = True
		Me.Label6.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label6.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label6.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label6.UseMnemonic = True
		Me.Label6.Visible = True
		Me.Label6.AutoSize = False
		Me.Label6.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label6.Name = "Label6"
		Me.Shape1.Size = New System.Drawing.Size(17, 17)
		Me.Shape1.Location = New System.Drawing.Point(444, 8)
		Me.Shape1.BackColor = System.Drawing.Color.Red
		Me.Shape1.Visible = True
		Me.Shape1.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
		Me.Shape1.ForeColor = System.Drawing.Color.Black
		Me.Shape1.Text = "Shape1"
		Me.Shape1.Name = "Shape1"
		Me.Label5.Text = "停止位:"
		Me.Label5.Size = New System.Drawing.Size(53, 13)
		Me.Label5.Location = New System.Drawing.Point(308, 12)
		Me.Label5.TabIndex = 10
		Me.Label5.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label5.BackColor = System.Drawing.SystemColors.Control
		Me.Label5.Enabled = True
		Me.Label5.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label5.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label5.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label5.UseMnemonic = True
		Me.Label5.Visible = True
		Me.Label5.AutoSize = False
		Me.Label5.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label5.Name = "Label5"
		Me.Label4.Text = "数据位:"
		Me.Label4.Size = New System.Drawing.Size(53, 13)
		Me.Label4.Location = New System.Drawing.Point(232, 12)
		Me.Label4.TabIndex = 9
		Me.Label4.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label4.BackColor = System.Drawing.SystemColors.Control
		Me.Label4.Enabled = True
		Me.Label4.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label4.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label4.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label4.UseMnemonic = True
		Me.Label4.Visible = True
		Me.Label4.AutoSize = False
		Me.Label4.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label4.Name = "Label4"
		Me.Label3.Text = "效验位:"
		Me.Label3.Size = New System.Drawing.Size(53, 13)
		Me.Label3.Location = New System.Drawing.Point(156, 12)
		Me.Label3.TabIndex = 8
		Me.Label3.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label3.BackColor = System.Drawing.SystemColors.Control
		Me.Label3.Enabled = True
		Me.Label3.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label3.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label3.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label3.UseMnemonic = True
		Me.Label3.Visible = True
		Me.Label3.AutoSize = False
		Me.Label3.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label3.Name = "Label3"
		Me.Label2.Text = "波特率:"
		Me.Label2.Size = New System.Drawing.Size(53, 13)
		Me.Label2.Location = New System.Drawing.Point(80, 12)
		Me.Label2.TabIndex = 7
		Me.Label2.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label2.BackColor = System.Drawing.SystemColors.Control
		Me.Label2.Enabled = True
		Me.Label2.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label2.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label2.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label2.UseMnemonic = True
		Me.Label2.Visible = True
		Me.Label2.AutoSize = False
		Me.Label2.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label2.Name = "Label2"
		Me.Label1.Text = "串口:"
		Me.Label1.Size = New System.Drawing.Size(53, 13)
		Me.Label1.Location = New System.Drawing.Point(4, 12)
		Me.Label1.TabIndex = 6
		Me.Label1.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label1.BackColor = System.Drawing.SystemColors.Control
		Me.Label1.Enabled = True
		Me.Label1.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label1.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label1.UseMnemonic = True
		Me.Label1.Visible = True
		Me.Label1.AutoSize = False
		Me.Label1.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label1.Name = "Label1"
		Me.Controls.Add(MSComm1)
		Me.Controls.Add(Command5)
		Me.Controls.Add(Combo5)
		Me.Controls.Add(Combo4)
		Me.Controls.Add(Combo3)
		Me.Controls.Add(Combo2)
		Me.Controls.Add(Combo1)
		Me.Controls.Add(Command4)
		Me.Controls.Add(Text2)
		Me.Controls.Add(Command3)
		Me.Controls.Add(Text1)
		Me.Controls.Add(Command2)
		Me.Controls.Add(Command1)
		Me.Controls.Add(Label7)
		Me.Controls.Add(Label6)
		Me.Controls.Add(Shape1)
		Me.Controls.Add(Label5)
		Me.Controls.Add(Label4)
		Me.Controls.Add(Label3)
		Me.Controls.Add(Label2)
		Me.Controls.Add(Label1)
		CType(Me.MSComm1, System.ComponentModel.ISupportInitialize).EndInit()
	End Sub
#End Region 
#Region "升级支持"
	Private Shared m_vb6FormDefInstance As Form1
	Private Shared m_InitializingDefInstance As Boolean
	Public Shared Property DefInstance() As Form1
		Get
			If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
				m_InitializingDefInstance = True
				m_vb6FormDefInstance = New Form1()
				m_InitializingDefInstance = False
			End If
			DefInstance = m_vb6FormDefInstance
		End Get
		Set
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	'串口调试工具 V1.0
	'Program:yc
	'Date: 2003/12/3
	
	Private ReadStr As String
	
	Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		With MSComm1
			.CommPort = 1 '选择串口COM1
			.Settings = "9600,N,8,1" '设置通信口参数
			.InBufferSize = 1024 '接收缓冲区大小
			.OutBufferSize = 1024 '发送缓冲区大小
			.InputMode = MSCommLib.InputModeConstants.comInputModeBinary '设置接收数据模式为二进制形式
			.InputLen = 0 '设置Input从接收缓冲读取全部数据
			.RThreshold = 1 '设置引发OnComm事件的字节长度
			.InBufferCount = 0 '清除接收缓冲区
			.OutBufferCount = 0 '清除发送缓冲区
		End With
		
		Form1.DefInstance.Top = VB6.TwipsToPixelsY((VB6.PixelsToTwipsY(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height) - VB6.PixelsToTwipsY(Form1.DefInstance.Height)) / 2) '程序居中显示
		Form1.DefInstance.Left = VB6.TwipsToPixelsX((VB6.PixelsToTwipsX(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width) - VB6.PixelsToTwipsX(Form1.DefInstance.Width)) / 2)
		
	End Sub
	'把发送文本框中的数据发送出去
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		Dim Str1 As String
		Str1 = Text2.Text
		If Len(Str1) >= 2 Then
			DSend((Str1))
		Else
			MsgBox("要发送的数据长度有误,请检查数据输入后再发送.", MsgBoxStyle.Information)
		End If
	End Sub
	'开启和关闭串口
	Private Sub Command4_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command4.Click
		On Error GoTo Err1
		If MSComm1.PortOpen = False Then
			MSComm1.CommPort = CShort(VB.Right(Combo1.Text, 1))
			MSComm1.Settings = Combo2.Text & "," & Combo3.Text & "," & Combo4.Text & "," & Combo5.Text
			MSComm1.PortOpen = True '打开通信口
			Shape1.BackColor = System.Drawing.ColorTranslator.FromOle(&HFF)
			Command4.Text = "关闭串口"
		ElseIf MSComm1.PortOpen = True Then 
			MSComm1.PortOpen = False '关闭通信口
			Shape1.BackColor = System.Drawing.ColorTranslator.FromOle(&H80000005)
			Command4.Text = "开启串口"
		End If
		Exit Sub
Err1: 
		Select Case Err.Number '串口被其它程序打开的出错提示
			Case 8005
				MsgBox("串口打开错误,可能串口被其它程序打开,请关闭其它程序再打开.", MsgBoxStyle.Information)
			Case Else
				MsgBox("程序出错:" & "出错代码. " & Err.Number & ": 出错提示信息: " & Err.Description, MsgBoxStyle.Information)
		End Select
	End Sub
	'关闭程序时确认串口关闭
	'UPGRADE_WARNING: Form 事件 Form1.Unload 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub Form1_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		If MSComm1.PortOpen = True Then
			MsgBox("关闭程序出错,请关闭串口后再关闭本程序.", MsgBoxStyle.Information)
			'UPGRADE_ISSUE: 事件参数 Cancel 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1057"”
			Cancel = 1
		End If
	End Sub
	'清空发送文本框
	Private Sub Command5_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command5.Click
		Text2.Text = ""
	End Sub
	'清空接收文本框
	Private Sub Command3_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command3.Click
		Text1.Text = ""
	End Sub
	'退出程序
	Private Sub Command2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command2.Click
		Me.Close()
	End Sub
	'数据发送函数
	Private Sub DSend(ByRef DataSend As String)
		Dim DataHex() As Byte
		Dim i As Short
		Dim k As Short
		
		MSComm1.OutBufferCount = 0 '清除发送缓冲区
		MSComm1.InBufferCount = 0 '清除接收缓冲区
		MSComm1.RThreshold = 1 '设置引发OnComm事件的字节长度
		
		i = (Len(DataSend)) / 2
		ReDim DataHex(i - 1)
		For k = 0 To (i - 1)
			DataHex(k) = CByte("&H" & VB.Right(VB.Left(DataSend, (k + 1) * 2), 2))
		Next k
		
		On Error GoTo Err2
		MSComm1.Output = VB6.CopyArray(DataHex) '发送数据
		Exit Sub
Err2: 
		Select Case Err.Number '串口没有打开的出错提示
			Case MSCommLib.ErrorConstants.comPortNotOpen
				MsgBox(Err.Description, MsgBoxStyle.Information)
			Case Else
				MsgBox("程序出错:" & "出错代码. " & Err.Number & ": 出错提示信息: " & Err.Description, MsgBoxStyle.Information)
		End Select
	End Sub
	'数据有返回时的响应
	Private Sub MSComm1_OnComm(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MSComm1.OnComm
		Dim i As Object
		Dim DataRead() As Byte
		Dim bytData As Object '用来从接收缓冲区读取数据
		On Error Resume Next
		With MSComm1
			Select Case .CommEvent
				Case MSCommLib.OnCommConstants.comEvReceive
					ReadStr = ""
					'UPGRADE_WARNING: 未能解析对象 MSComm1.Input 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
					'UPGRADE_WARNING: 未能解析对象 bytData 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
					bytData = .Input
					ReDim DataRead(UBound(bytData))
					For i = 0 To UBound(bytData)
						'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						'UPGRADE_WARNING: 未能解析对象 bytData() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						DataRead(i) = bytData(i)
						'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						ReadStr = ReadStr & Hex2(CStr(DataRead(i)))
					Next i
					Text1.Text = Text1.Text & ReadStr '将读取出来的数据发送到文本框中显示出来
			End Select
		End With
	End Sub
	Private Function Hex2(ByRef c As String) As String
		Hex2 = Hex(CInt(c))
		If Len(Hex2) < 2 Then
			Hex2 = "0" & Hex2
		End If
	End Function
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 Text2.TextChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub Text2_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Text2.TextChanged
		'输入长度和其偶
		If Len(Text2.Text) Mod 2 = 0 Then
			Label7.Text = Len(Text2.Text) & " " & "偶数"
		Else
			Label7.Text = Len(Text2.Text) & " " & "基数"
		End If
	End Sub
	
	Private Sub Text2_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles Text2.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		'数据输入自动转化为大写字母
		If KeyAscii >= 97 And KeyAscii <= 122 Then
			'UPGRADE_ISSUE: 不支持赋值: KeyAscii 被赋予非零值 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1058"”
			KeyAscii = KeyAscii - 32
		End If
		'只能输入0-F之间的数
		If KeyAscii <> 8 And (KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii < 65 Or KeyAscii > 70) Then
			Beep()
			KeyAscii = 0
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
End Class