界面如下:
登陆界面源代码:
Option Explicit
Private Sub Combo1_Change()
End Sub
Private Sub Command1_Click()
Dim m1$, m2$, r%
m1 = " 密码或者账户错误!是否继续?"
m2 = "密码检查对话框"
If Combo_key.Text = "李三" Then
If Text_password = "" Then
'Load Form_main
Form_main.Show
Me.Hide
Else
r = MsgBox(m1, 34, m2)
End If
ElseIf Combo_key.Text = "domyself" Then
If Text_password = "110" Then
Form_main.Show
Unload Form_loading
Else
r = MsgBox(m1, 34, m2)
End If
Else
r = MsgBox(m1, 34, m2)
End If
End Sub
Private Sub Command2_Click() '将账户和密码框清空
Text_password.Text = ""
Combo_key.Text = ""
End Sub
Private Sub Form_Load()
'密码框长度
Text_password.MaxLength = 20
'把密码输入栏设置成*显示
Text_password.PasswordChar = "*"
Combo_key.AddItem "李三"
Text_password.Text = ""
Combo_key.Text = ""
End Sub
'关闭当前窗体
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Form_gsm
Unload Form_gps
Unload Form_main
Unload Form_direct_receive
Unload Form_loading
End Sub
2、软件选择界面的设计。
当登陆软件成功之后,进入这个界面。如下:
源代码如下:
Option Explicit
Private Sub Command1_Click()
If Option_d.Value Then
Form_direct_receive.Show
'gps数据直接接收
Form_main.Hide
ElseIf Option_gps.Value Then
Form_gps.Show
'gps存取数据读取
Form_main.Hide
ElseIf Option_gsm.Value Then
'GSM模式
Form_gsm.Show
Form_main.Hide
End If
End Sub
Private Sub Command2_Click()
Unload Form_direct_receive
Unload Form_loading
Unload Form_gps
Unload Form_gsm
Unload Form_main
End Sub
Private Sub Form_Load()
Unload Form_gps
Unload Form_gsm
Unload Form_direct_receive
Option_gps.Value = True
Image1.Left = 0
Image1.Top = 0
End Sub
Private Sub Form_resize()
Image1.Width = Form_main.ScaleWidth
Image1.Height = Form_main.ScaleHeight
End Sub
Private Sub Image1_Click()
End Sub
Private Sub Option_d_Click()
'Option_d.Value = True
End Sub
'关闭当前窗体
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Form_gsm
Unload Form_gps
Unload Form_direct_receive
Unload Form_loading
Unload Form_main
End Sub
为软件添加背景图片方法如下:
添加一个image控件,通过其picture属性,选择背景图片。
在初始化的时候:
Image1.Left = 0
Image1.Top = 0
在resize事件中:
Private Sub Form_resize()
Image1.Width = Form_main.ScaleWidth
Image1.Height = Form_main.ScaleHeight
End Sub
上面代码的作用是让该图片和程序主窗体一起变大变小。
3、GPS模块
安全起见把地理位置给抹掉了。
源代码如下:
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
Option Explicit
Dim flag_dis As Boolean '是否停止显示标志量
Dim rx_count As Single '接收到的字符数
Dim tx_count As Single '发送除去的字符数
Dim inputsignal
Dim text_temp As String '接收文本数据缓存
Dim x1 As String, x2 As String, x3 As String, x4 As String, x5 As String
Dim comset_temp As String
Dim string_save As String
Private Sub Combo1_click()
Call comm_set
End Sub
Private Sub Combo2_click()
Call comm_set
End Sub
Private Sub Combo3_click()
Call comm_set
End Sub
Private Sub Combo4_click()
Call comm_set
End Sub
Private Sub Combo5_click()
Call comm_set
End Sub
'返回按键
Private Sub Command_back_Click()
On Error Resume Next
MSComm1.PortOpen = False
If Err.Number = 8012 Then
End If
Shape1.FillColor = QBColor(8) '黑色
Command_open.Caption = "打开串口"
Text_rx.Text = ""
Text_tx.Text = ""
Load Form_main '加载主窗体
Form_main.Show '显示主 窗体
Me.Hide
End Sub
'清空发送接收计数
Private Sub Command_clear_count_Click()
rx_count = 0
tx_count = 0
End Sub
'串口打开按键
Private Sub Command_open_Click()
If Command_open.Caption = "打开串口" Then
Command_open.Caption = "关闭串口"
Shape1.FillColor = QBColor(12) '红色
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
Else
Command_open.Caption = "打开串口"
Shape1.FillColor = QBColor(8) '黑色
On Error Resume Next
MSComm1.PortOpen = False
If Err.Number = 8012 Then
End If
End If
End Sub
'停止显示
'手动发送
Private Sub Command_send_Click()
On Error Resume Next '此句放在出错语句的前面
MSComm1.Output = Text_tx.Text
tx_count = tx_count + Len(Text_tx.Text)
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
'Next
End Sub
'窗体初始化
Private Sub Form_Load()
MSComm1.Settings = "9600,n,8,1" '串口的相关参数设置
MSComm1.CommPort = 1 '串口1
MSComm1.InputLen = 0 '表示一次读取所有数据
MSComm1.InBufferSize = 5120
MSComm1.InBufferCount = 0
MSComm1.OutBufferSize = 5120
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 1 '每接收一个字符触发一次oncomm事件
MSComm1.SThreshold = 1
Shape1.Shape = 2
Shape1.Visible = True
Shape1.FillStyle = 0 '全部填充
Shape1.FillColor = QBColor(12) '红色
On Error Resume Next
MSComm1.PortOpen = True '打开串口
If Err.Number = 8018 Then
Shape1.FillColor = QBColor(8) '黑色
End If
flag_dis = False
rx_count = 0
tx_count = 0
Label_rx.Caption = rx_count '接收到的字符数
Label_tx.Caption = tx_count '发送出去的字符数
Combo1.AddItem "COM1"
Combo1.AddItem "COM2"
Combo1.AddItem "COM3"
Combo1.AddItem "COM4"
'波特率
Combo2.AddItem "300"
Combo2.AddItem "600"
Combo2.AddItem "1200"
Combo2.AddItem "2400"
Combo2.AddItem "4800"
Combo2.AddItem "9600"
Combo2.AddItem "19200"
Combo2.AddItem "38400"
Combo2.AddItem "43000"
Combo2.AddItem "115200"
'校验位
Combo3.AddItem "N"
Combo3.AddItem "E"
Combo3.AddItem "O"
'数据位
Combo4.AddItem "8"
Combo4.AddItem "7"
Combo4.AddItem "6"
'停止位
Combo5.AddItem "1"
Combo5.AddItem "2"
'设置combobox.text初始值
Combo1.Text = "COM1"
Combo2.Text = "4800"
Combo3.Text = "N"
Combo4.Text = "8"
Combo5.Text = "1"
'串口设置下拉框颜色设置
Combo1.ForeColor = RGB(255, 0, 0)
Combo1.BackColor = RGB(12, 0, 0)
Combo2.ForeColor = RGB(255, 0, 0)
Combo2.BackColor = RGB(12, 0, 0)
Combo3.ForeColor = RGB(255, 0, 0)
Combo3.BackColor = RGB(12, 0, 0)
Combo4.ForeColor = RGB(255, 0, 0)
Combo4.BackColor = RGB(12, 0, 0)
Combo5.ForeColor = RGB(255, 0, 0)
Combo5.BackColor = RGB(12, 0, 0)
'清空接收发送文本框
Text_rx.Text = ""
Text_tx.Text = ""
'接收发送计数器清0
rx_count = 0
tx_count = 0
Label_rx.Caption = rx_count '接收到的字符数
Label_tx.Caption = tx_count '发送出去的字符数
Timer1.Enabled = True
Timer1.Interval = 250
'Call new_folder
Call comm_set
Call new_folder
End Sub
Private Sub Label_SAVE_Click()
Dim sA As String * 65400 '声明定长String变量
Open "C:\COM_DATA\GPS\gps_data.txt" For Binary As #1 '用二进制打开文件
Get #1, , sA '用Get语句从文件中获取字节
Text_rx.Text = sA '显示打开的文件
Close #1 '关闭文件
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'定时器1用于接收发送量显示
Private Sub Timer1_Timer()
Label_rx.Caption = rx_count
Label_tx.Caption = tx_count
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'清空接受区
Private Sub Command_clear_rx_Click()
Text_rx.Text = ""
string_save = ""
End Sub
'计数清0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'停止显示
Private Sub Command_dis_Click()
If flag_dis = False Then
flag_dis = True
Command_dis.Caption = "继续显示"
Else
flag_dis = False
Command_dis.Caption = "停止显示"
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'串口响应事件
Private Sub mscomm1_oncomm()
Select Case MSComm1.CommEvent
Case comEvReceive
inputsignal = MSComm1.Input
rx_count = Len(Trim(inputsignal)) + rx_count
'If inputsignal <> vbCr Then
string_save = inputsignal & string_save
'End If
If flag_dis = True Then
text_temp = Text_rx.Text '将接收区的文本信息锁存
Text_rx.Text = text_temp
Else
Text_rx.Text = (Text_rx.Text) & (inputsignal)
End If
Case Else
End Select
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'***************************
'串口设置
Public Sub comm_set()
If MSComm1.PortOpen <> False Then
MSComm1.PortOpen = False
End If
x1 = Combo1.Text
x2 = Combo2.Text
x3 = Combo3.Text
x4 = Combo4.Text
x5 = Combo5.Text
MSComm1.InputLen = 0 '表示一次读取所有数据
MSComm1.InBufferSize = 512
MSComm1.InBufferCount = 0
MSComm1.OutBufferSize = 512
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 1 '每接收一个字符触发一次oncomm事件
MSComm1.SThreshold = 1
MSComm1.CommPort = Val(Right(x1, 1))
comset_temp = x2 & "," & x3 & "," & x4 & "," & x5
MSComm1.Settings = (comset_temp)
Command_open.Caption = "打开串口"
Shape1.FillColor = QBColor(8) '黑色
End Sub
'创建一个文件
Public Sub new_folder()
Dim fol, fso, fil, fils, s, f, fldr
Dim aa As String
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
aa$ = "C:\COM_DATA"
If fso.folderexists(aa$) = False Then
fol = fso.CreateFolder(aa$)
'MkDir aa
End If
aa$ = "C:\COM_DATA\GPS"
If fso.folderexists(aa$) = False Then
fol = fso.CreateFolder(aa$)
'MkDir aa
End If
End Sub
'保存接收到的数据
Private Sub Command_save_Click()
Call new_folder
Open Label_SAVE.Caption & "\gps_data.txt" For Append As #1
Write #1, " 保存系统时间:", Format(Now, "yyyy年m月dd日 hh:mm")
Write #1, Text_rx.Text
Close #1 '关闭文件
End Sub
'关闭当前窗体
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Form_gsm
Unload Form_gps
Unload Form_main
Unload Form_direct_receive
Unload Form_loading
End Sub
4、GSM模块界面如下
源代码如下:
Option Explicit
Dim inputsignal
Dim text_temp As String
'Dim flag_dis As Boolean '是否停止显示标志量
'Dim rx_count As Single '接收到的字符数
'Dim tx_count As Single '发送除去的字符数
'***********************************
'串口配置信息缓存配置字符串
Dim x1 As String, x2 As String, x3 As String, x4 As String, x5 As String
Dim num_center As String '中心号码
Dim comset_temp As String
Dim flag_connect As Integer
Dim flag_write_eeprom As Integer
Dim buff_connect As String
'延时函数
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private savetime As Double
Function delay(JianGe As Long) '以毫秒为单位
'JianGe时间间隔
savetime = timeGetTime
While timeGetTime < savetime + JianGe
DoEvents
Wend
End Function
Private Sub Combo_common_msg_Click()
Text_msg_send.Text = Combo_common_msg.Text
End Sub
'AT指令测试
Private Sub Command_AT_Click()
Text_rx.Text = ""
On Error Resume Next
MSComm1.Output = "AT" & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开"
End If
End Sub
Private Sub Command_call_Click()
On Error Resume Next
MSComm1.Output = "ATD" & Left(Combo_dst_number.Text, 11) & ";" & vbCr
Text_rx.Text = ""
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End Sub
'连接PC机串口按钮
Private Sub Command_connect_Click()
flag_connect = 1
Text_rx.Text = "" '清空接收显示区
On Error Resume Next
MSComm1.Output = "######"
If Err.Number = 8018 Then
MsgBox "串口尚未打开,请先打开串口!"
End If
delay (1000) '如果在一秒内串口未收到任何回应视为连接失败
If flag_connect = 1 Then
Label_connect.Caption = "连接失败"
End If
delay (1500)
Label_connect.Caption = ""
End Sub
'设置被叫方电话号码
Private Sub Command_dst_num_Click()
Text_rx.Text = ""
On Error Resume Next
MSComm1.Output = "AT+CMGS=" & Left(Combo_dst_number.Text, 11) & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End Sub
'GSM格式化指令
Private Sub Command_format_Click()
Text_rx.Text = ""
On Error Resume Next
MSComm1.Output = "AT&F" & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End Sub
'清空接收区
Private Sub Command_clear_Click()
Text_rx.Text = ""
End Sub
Private Sub Command_hold_Click()
On Error Resume Next
MSComm1.Output = "ATH" & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End Sub
'设置GSM模式
Private Sub Command_mode_set_Click()
On Error Resume Next
MSComm1.Output = "AT+CMGF=1" & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End Sub
'手动发送按钮
Private Sub Command_send_Click()
On Error Resume Next
MSComm1.Output = Text_tx.Text
If Err.Number = 8018 Then
MsgBox "串口尚未打开"
End If
End Sub
'发送短信
Private Sub Command_send_msg_Click()
Text_rx.Text = ""
On Error Resume Next
MSComm1.Output = Text_msg_send.Text & Chr(&H1A) & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End Sub
Private Sub Command_send_one_key_Click()
On Error Resume Next
MSComm1.Output = "AT" & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
delay (1000)
Text_rx.Text = ""
MSComm1.Output = "AT+CMGF=1" & vbCr
delay (1000)
Text_rx.Text = ""
If Combo_sim_type.Text = "中国移动" Then
If Combo_src_addr.Text = "杭州" Then
MSComm1.Output = "AT+CSCA=+8613800571500" & vbCr
ElseIf Combo_src_addr.Text = "孝感" Then
MSComm1.Output = "AT+CSCA=+8613800712500" & vbCr
ElseIf Combo_src_addr.Text = "荆州" Then
MSComm1.Output = "AT+CSCA=+8613800716500" & vbCr
ElseIf Combo_src_addr.Text = "武汉" Then
MSComm1.Output = "AT+CSCA=+8613800270500" & vbCr
End If
ElseIf Combo_sim_type.Text = "中国联通" Then
MSComm1.Output = "AT+CSCA=+8613010710500" & vbCr '湖北地区联通中心号
End If
delay (1000)
Text_rx.Text = ""
MSComm1.Output = "AT+CMGS=" & Left(Combo_dst_number.Text, 11) & vbCr
delay (1000)
Text_rx.Text = ""
MSComm1.Output = Text_msg_send.Text
delay (2000)
MSComm1.Output = Chr(&H1A) & vbCr
End Sub
'设置本地卡归属地中心号码
Private Sub Command_src_addr_Click()
Text_rx.Text = ""
If Combo_sim_type.Text = "中国移动" Then
If Combo_src_addr.Text = "杭州" Then
MSComm1.Output = "AT+CSCA=+8613800571500" & vbCr
ElseIf Combo_src_addr.Text = "孝感" Then
MSComm1.Output = "AT+CSCA=+8613800712500" & vbCr
ElseIf Combo_src_addr.Text = "荆州" Then
MSComm1.Output = "AT+CSCA=+8613800716500" & vbCr
ElseIf Combo_src_addr.Text = "武汉" Then
MSComm1.Output = "AT+CSCA=+8613800270500" & vbCr
End If
ElseIf Combo_sim_type.Text = "中国联通" Then
On Error Resume Next
MSComm1.Output = "AT+CSCA=+8613010710500" & vbCr '湖北地区联通中心号
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End If
End Sub
Private Sub Command2_Click()
End Sub
Private Sub Command_write_eeprom_Click()
Text_rx.Text = "" '清空接收显示区
flag_write_eeprom = 1
On Error Resume Next
MSComm1.Output = "*" & Combo_dst_number.Text
If Err.Number = 8018 Then
MsgBox "串口尚未打开,请先打开串口!"
End If
delay (1500)
'Text_rx.Text = "" '清空接收显示区
Label_write_eeprom.Caption = ""
End Sub
'窗体初始化
Private Sub Form_Load()
flag_connect = 0
flag_write_eeprom = 0
MSComm1.Settings = "9600,n,8,1" '串口的相关参数设置
MSComm1.CommPort = 1 '串口1
MSComm1.InputLen = 0 '表示一次读取所有数据
MSComm1.InBufferSize = 5120
MSComm1.InBufferCount = 0
MSComm1.OutBufferSize = 5120
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 1 '每接收一个字符触发一次oncomm事件
MSComm1.SThreshold = 1
On Error Resume Next
MSComm1.PortOpen = True '打开串口
If Err.Number = 8012 Then
End If
Shape1.Shape = 2
Shape1.Visible = True
Shape1.FillStyle = 0 '全部填充
Shape1.FillColor = QBColor(12) '红色
Timer1.Enabled = True
Timer1.Interval = 250
Text_rx.Text = ""
Text_tx.Text = ""
'串口选择
Combo1.AddItem "COM1"
Combo1.AddItem "COM2"
Combo1.AddItem "COM3"
Combo1.AddItem "COM4"
'波特率
Combo2.AddItem "300"
Combo2.AddItem "600"
Combo2.AddItem "1200"
Combo2.AddItem "2400"
Combo2.AddItem "4800"
Combo2.AddItem "9600"
Combo2.AddItem "19200"
Combo2.AddItem "38400"
Combo2.AddItem "43000"
Combo2.AddItem "115200"
'校验位
Combo3.AddItem "N"
Combo3.AddItem "E"
Combo3.AddItem "O"
'数据位
Combo4.AddItem "8"
Combo4.AddItem "7"
Combo4.AddItem "6"
'停止位
Combo5.AddItem "1"
Combo5.AddItem "2"
'设置combobox.text初始值
Combo1.Text = "COM1"
Combo2.Text = "4800"
Combo3.Text = "N"
Combo4.Text = "8"
Combo5.Text = "1"
'本地SIM卡归属地
Combo_src_addr.AddItem "杭州"
Combo_src_addr.AddItem "荆州"
Combo_src_addr.AddItem "孝感"
Combo_src_addr.AddItem "武汉"
'Combo_src_addr.ForeColor = RGB(255, 0, 0)
'Combo_src_addr.BackColor = RGB(12, 0, 0)
'被呼叫方电话号码
Combo_dst_number.AddItem "18858113527(吴)"
Combo_dst_number.AddItem "15826521677(刘迎春)"
Combo_dst_number.AddItem "13437230576(刘焦)"
Combo_dst_number.AddItem "15872101573(刘永正)"
Combo_dst_number.AddItem "18995864714(童华春)"
Combo_dst_number.AddItem "13545688075(吴师)"
Combo_dst_number.AddItem "13697304840(洪志鹏)"
Combo_dst_number.AddItem "13277324783(刘继超)"
'本地sim卡类型设置
Combo_sim_type.AddItem "中国移动"
Combo_sim_type.AddItem "中国联通"
Combo_src_addr.Text = "孝感"
Combo_dst_number.Text = "18757134743"
Combo_sim_type.Text = "中国联通"
Text_msg_send.Text = "Come back to eat!" '清空短信发送区内容
Combo_common_msg.AddItem "Come back to eat!"
Combo_common_msg.AddItem "Happy new year!"
Combo_common_msg.AddItem "I love u 1314!"
Combo_common_msg.AddItem "I am busy,I will connect with you later!"
Combo_common_msg.Text = "Come back to eat!"
Call comm_set
End Sub
'串口参数设置下拉框控制
Private Sub Combo1_click()
Call comm_set
End Sub
Private Sub Combo2_click()
Call comm_set
End Sub
Private Sub Combo3_click()
Call comm_set
End Sub
Private Sub Combo4_click()
Call comm_set
End Sub
Private Sub Combo5_click()
Call comm_set
End Sub
'返回上一级按键
Private Sub Command_back_Click()
On Error Resume Next
MSComm1.PortOpen = False
If Err.Number = 8012 Then
End If
Shape1.FillColor = QBColor(8) '黑色
Command_open.Caption = "打开串口"
Text_rx.Text = ""
Text_tx.Text = ""
Load Form_main '加载主窗体
Form_main.Show '显示主 窗体
Form_gsm.Hide
End Sub
'打开串口
Private Sub Command_open_Click()
If Command_open.Caption = "打开串口" Then
On Error Resume Next
MSComm1.PortOpen = True
Command_open.Caption = "关闭串口"
Shape1.FillColor = QBColor(12) '红色
If Err.Number = 8005 Then
MsgBox "串口已被占用!"
Command_open.Caption = "打开串口"
Shape1.FillColor = QBColor(8) '黑色
End If
Else
Command_open.Caption = "打开串口"
On Error Resume Next
MSComm1.PortOpen = False
If Err.Number = 8012 Then
End If
Shape1.FillColor = QBColor(8) '黑色
End If
End Sub
'串口相关参数设定
Public Sub comm_set()
If MSComm1.PortOpen <> False Then
MSComm1.PortOpen = False
End If
x1 = Combo1.Text
x2 = Combo2.Text
x3 = Combo3.Text
x4 = Combo4.Text
x5 = Combo5.Text
MSComm1.InputLen = 0 '表示一次读取所有数据
MSComm1.InBufferSize = 512
MSComm1.InBufferCount = 0
MSComm1.OutBufferSize = 512
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 1 '每接收一个字符触发一次oncomm事件
MSComm1.SThreshold = 1
MSComm1.CommPort = Val(Right(x1, 1))
comset_temp = x2 & "," & x3 & "," & x4 & "," & x5
MSComm1.Settings = (comset_temp)
Command_open.Caption = "打开串口"
Shape1.FillColor = QBColor(8) '黑色
End Sub
Private Sub Label6_Click()
End Sub
'串口响应事件
Private Sub mscomm1_oncomm()
Select Case MSComm1.CommEvent
Case comEvReceive
inputsignal = MSComm1.Input
If flag_connect = 1 Then
flag_connect = 0
buff_connect = buff_connect & inputsignal
If buff_connect = "######" Then
Label_connect.Caption = "连接成功"
buff_connect = ""
delay (1000)
Label_connect.Caption = ""
Text_rx.Text = "" '清空接收显示区
Else
Label_connect.Caption = "连接失败"
buff_connect = ""
delay (1000) '延时1秒钟
Text_rx.Text = "" '清空接收显示区
Label_connect.Caption = ""
End If
End If
If flag_write_eeprom = 1 Then
buff_connect = buff_connect & inputsignal
If Right(buff_connect, 11) = Combo_dst_number.Text Then
Label_write_eeprom.Caption = "写EEPROM成功"
flag_write_eeprom = 0
End If
End If
Text_rx.Text = (Text_rx.Text) & (inputsignal)
Case Else
End Select
End Sub
Private Sub 发送区_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
'关闭当前窗体
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Form_gps
Unload Form_main
Unload Form_direct_receive
Unload Form_loading
Unload Form_gsm
End Sub
还有一个界面待扩充。
运行后其他界面:
总结如下:
1、窗体的卸载:
Unload Form_gps
Unload Form_gsm
Unload Form_direct_receive
Option_gps.Value = True
卸载当前窗体亦可:
Unload Me
2、出错检查和弹出
On Error Resume Next
MSComm1.Output = "AT" & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
On Error Resume Next应该放在可能出错的那一句代码之前。
然后在If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
中进行纠错处理。
错误码:8018 串口尚未打开
错误码:8012 串口已经打开
错误码:8005 当前串口被占用
一个软件要编写完美,就必须考虑到所有可能出错的地方,然后设置相应的纠错码。
3、文件夹的创建
'创建一个文件
Public Sub new_folder()
Dim fol, fso, fil, fils, s, f, fldr
Dim aa As String
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
aa$ = "C:\COM_DATA"
If fso.folderexists(aa$) = False Then
fol = fso.CreateFolder(aa$)
'MkDir aa
End If
aa$ = "C:\COM_DATA\GPS"
If fso.folderexists(aa$) = False Then
fol = fso.CreateFolder(aa$)
'MkDir aa
End If
End Sub
一个多级目录是一级级创建起来的,不是直接一次就创建好的。
调用的时候直接 call new_folder即可
4、txt文件的写入
'保存接收到的数据
Private Sub Command_save_Click()
Call new_folder
Open Label_SAVE.Caption & "\gps_data.txt" For Append As #1
Write #1, " 保存系统时间:", Format(Now, "yyyy年m月dd日 hh:mm")
Write #1, string_save
Close #1 '关闭文件
End Sub
5、打开串口
'打开串口
Private Sub Command_open_Click()
If Command_open.Caption = "打开串口" Then
On Error Resume Next
MSComm1.PortOpen = True
Command_open.Caption = "关闭串口"
Shape1.FillColor = QBColor(12) '红色
If Err.Number = 8005 Then
MsgBox "串口已被占用!"
Command_open.Caption = "打开串口"
Shape1.FillColor = QBColor(8) '黑色
End If
Else
Command_open.Caption = "打开串口"
On Error Resume Next
MSComm1.PortOpen = False
If Err.Number = 8012 Then
End If
Shape1.FillColor = QBColor(8) '黑色
End If
End Sub
If Err.Number = 8005 Then
MsgBox "串口已被占用!"
Command_open.Caption = "打开串口"
Shape1.FillColor = QBColor(8) '黑色
End If
这里保证了串口的打开状态和shape颜色以及command的text属性文字的一致性。
5、上位机和下位机连接过程的实现
'连接PC机串口按钮
Private Sub Command_connect_Click()
flag_connect = 1
Text_rx.Text = "" '清空接收显示区
On Error Resume Next
MSComm1.Output = "######"
If Err.Number = 8018 Then
MsgBox "串口尚未打开,请先打开串口!"
End If
delay (1000) '如果在一秒内串口未收到任何回应视为连接失败
If flag_connect = 1 Then
Label_connect.Caption = "连接失败"
End If
delay (1500)
Label_connect.Caption = ""
End Sub
6、延时函数
'延时函数
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private savetime As Double
Function delay(JianGe As Long) '以毫秒为单位
'JianGe时间间隔
savetime = timeGetTime
While timeGetTime < savetime + JianGe
DoEvents
Wend
End Function
7、Left函数和Right函数的使用。
If Right(buff_connect, 11) = Combo_dst_number.Text Then
Label_write_eeprom.Caption = "写EEPROM成功"
flag_write_eeprom = 0
End If
MSComm1.CommPort = Val(Right(x1, 1))
8、窗体的显示与隐藏
'返回上一级按键
Private Sub Command_back_Click()
On Error Resume Next
MSComm1.PortOpen = False
If Err.Number = 8012 Then
End If
Shape1.FillColor = QBColor(8) '黑色
Command_open.Caption = "打开串口"
Text_rx.Text = ""
Text_tx.Text = ""
Load Form_main '加载主窗体
Form_main.Show '显示主 窗体
Form_gsm.Hide
End Sub
从上面可以看出,退出当前程序界面回到上一界面的时候,操作如下:
先加载主窗体,然后显示。
9、登陆密码框的“*”显示
Text_password.MaxLength = 20
'设置密码框的长度
Text_password.PasswordChar = "*"
'把密码输入栏设置成*显示
VB使用中应该注意的一些小问题
1.关于mscomm控件使用中应该注意的问题
(1) MSComm1.Output 只能写 不能读
所以 不能他的值作为if的判断条件
否则编译的时候会报错,而且不会起到作用!
(2) 错误码代表的具体错误
编译错误号是8018时,串口尚未打开
编译错误号是8012时,串口已经打开
编译错误号是8005时,说明此串口已经被另一软件占用中
这种问题的处理方法如下:
'打开串口
Private Sub Command_open_Click()
If Command_open.Caption = "打开串口" Then
On Error Resume Next
MSComm1.PortOpen = True
Command_open.Caption = "关闭串口"
Shape1.FillColor = QBColor(12) '红色
If Err.Number = 8005 Then
MsgBox "串口已被占用!"
Command_open.Caption = "打开串口"
Shape1.FillColor = QBColor(8) '黑色
End If
Else
Command_open.Caption = "打开串口"
MSComm1.PortOpen = False
Shape1.FillColor = QBColor(8) '黑色
End If
End Sub
2.代码中的错误检测(两种方式的区别)
On Error GoTo 0
表示禁止当前过程中任何已启动的错误处理程序。
On Error Resume Next
说明当一个运行时错误发生时,控件转到紧接着发生错误的语句之后的语句,并在此继续运行。访问对象时要使用这种形式而不使用 On Error GoTo。
On Error GoTo line
启动错误处理程序,且该例程从必要的 line 参数中指定的 line 开始。line 参数可以是任何行标签或行号。如果发生一个运行时错误,则控件会跳到 line,激活错误处理程序。指定的 line 必须在一个过程中,这个过程与 On Error 语句相同; 否则会发生编译时间错误。
以上MSDN上的解释
一般情况下,如果在对我们创建的对象或控件进行错误捕捉,需要使用On Error Resume Next ,然后在判断它的Err.Number,根据错误类型来做相应的处理。
举例如下:
Private Sub Command_send_msg_Click()
Text_rx.Text = ""
On Error Resume Next
MSComm1.Output = Text_msg_send.Text & Chr(&H1A) & vbCr
If Err.Number = 8018 Then
MsgBox "串口尚未打开!"
End If
End Sub
3.& 连接符使用中应该注意的问题
&把两个字符串前后连接在一起 ,但是两边一定要有空格。否则编译器会提示出错。
例如: "I love"&"you!"这样就会提示报错。正确做法如下:
"I love" & "you!"
4.VB中延时功能的实现
'延时函数
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private savetime As Double
Function delay(JianGe As Long) '以毫秒为单位
'JianGe时间间隔
savetime = timeGetTime
While timeGetTime < savetime + JianGe
DoEvents
Wend
End Function
4.常用字符串操作
val(string) 将字符串转换成数字
5.直接利用窗体的Picture好像不行(我不知道而已)。不过可以通过Image控件的帮助实现这个效果。
在窗体上添加一个Image控件,将它的stretch属性设为True,再通过它的Picture属性载入一张图片,然后将它的Left和Top都设成0,再调整它的大小,使它充满整个窗体。
再在窗体的Resize()事件中添加如下代码:
Image1.Width = Form1.ScaleWidth
Image1.Height = Form1.ScaleHeight
如果在其他事件过程中,可以直接调用,如:
call Command1_Click