vb-串口程序

Posted on | In | | Visitors:

介绍

  • 使用 vb 编写，这类工具很多，练手用
  • 使用 MSComm
  • 串口调试工具
  • 支持多语言
  • 没有更多功能
  • 相关
    1. GetSystemDefaultLCID（实现多语言的切换）
    2. Timer（定时器，刷新数据）

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
Option Explicit
Dim portopen As Integer
Dim cmd_open As String
Dim cmd_close As String
Dim msg As String
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long

Private Sub Form_Load()
Dim localid As Long
localid = GetSystemDefaultLCID
Select Case localid
Case &H404 '繁体语言
cmd_open = "打開"
cmd_close = "關閉"
msg = "串口未打開!"
Form1.Caption = "串口調試(KB_Vision)"
Label1.Caption = "端口號"
Label2.Caption = "波特率"
Label3.Caption = "數據位"
Label4.Caption = "停止位"
Label5.Caption = "較驗位"
Command1.Caption = cmd_close
Command2.Caption = "發送"
send.Text = "發送區"
receive.Text = "接收區"
Check1.Caption = "自動發送"
Case &H804 '简体语言
cmd_open = "打开"
cmd_close = "关闭"
msg = "串口没打开！"
Form1.Caption = "串口调试(KB_Vision)"
Label1.Caption = "端口号"
Label2.Caption = "波特率"
Label3.Caption = "数据位"
Label4.Caption = "停止位"
Label5.Caption = "校验位"
Command1.Caption = cmd_close
Command2.Caption = "发送"
send.Text = "发送区"
receive.Text = "接收区"
Check1.Caption = "自动发送"
Case &H409 'English
cmd_open = "Open"
cmd_close = "Close"
msg = "No comport open"
Form1.Caption = "Comdebug(KB_Vision)"
Label1.Caption = "Comport"
Label2.Caption = "Baudrate"
Label3.Caption = "Databits"
Label4.Caption = "Stopbits"
Label5.Caption = "Parity"
Command1.Caption = cmd_close
Command2.Caption = "Send"
send.Text = "SendText"
receive.Text = "ReceiveText"
Check1.Caption = "Auto Send"
End Select
tip.Caption = ""
comport.ListIndex = 0
sendTimer.Enabled = False
receTimer.Enabled = False
End Sub

Private Sub Command1_Click()
Dim baudrateset As String
Dim parityset As String
Dim databitset As String
Dim stopbitset As String
Dim comset As String
baudrateset = baudrate.Text
parityset = Left(parity.Text, 1)
databitset = databits.Text
stopbitset = stopbits.Text
comset = baudrateset + "," + parityset + "," + databitset + "," + stopbitset
On Error GoTo showerr
If (portopen = 0) Then
Command1.Caption = cmd_open
portopen = 1
MSComm.CommPort = comport.ListIndex + 1
MSComm.Settings = comset
'Print MSComm.Settings
MSComm.InputLen = 0
MSComm.InBufferSize = 1024
MSComm.InputMode = 0
MSComm.RThreshold = 1
MSComm.RTSEnable = True
MSComm.SThreshold = 0
MSComm.portopen = True
tip.Caption = "Ok"
tip.ForeColor = RGB(0, 255, 0)
receTimer.Enabled = True
send.Text = ""
receive.Text = ""
Else
portopen = 0
Command1.Caption = cmd_close
tip.Caption = ""
tip.ForeColor = RGB(0, 0, 0)
receTimer.Enabled = False
MSComm.portopen = False
Check1.Value = 0
End If
Exit Sub
'err tip
showerr:
If (portopen = 1) Then
tip.Caption = "Err"
tip.ForeColor = RGB(255, 0, 0)
Else
tip.Caption = ""
tip.ForeColor = RGB(0, 0, 0)
End If
End Sub

Private Sub Command2_Click()
If (tip.Caption = "Ok") Then
MSComm.Output = send.Text
Else
MsgBox (msg)
End If
End Sub

Private Sub Check1_Click()
If Check1.Value = 1 Then
sendTimer.Enabled = True
sendTimer.Interval = Time.Text
Else
sendTimer.Enabled = False
End If
End Sub

Private Sub sendTimer_Timer()
If (tip.Caption = "Ok") Then
MSComm.Output = send.Text
Else
MsgBox (msg)
sendTimer.Enabled = False
Check1.Value = 0
End If
End Sub

Private Sub receTimer_Timer()
If (tip.Caption = "Ok") Then
receive.Text = receive.Text + MSComm.Input
receive.SelStart = Len(receive.Text)
End If
DoEvents
End Sub
坚持原创技术分享，您的支持将鼓励我继续创作！