Chinaunix首页 | 论坛 | 博客
  • 博客访问: 2012850
  • 博文数量: 356
  • 博客积分: 8284
  • 博客等级: 中将
  • 技术积分: 4580
  • 用 户 组: 普通用户
  • 注册时间: 2009-05-15 20:25
个人简介

天行健,君子以自强不息

文章分类

全部博文(356)

文章存档

2018年(1)

2016年(4)

2015年(13)

2014年(14)

2013年(2)

2012年(25)

2011年(43)

2010年(65)

2009年(189)

分类: 项目管理

2011-05-09 09:45:31

 
1、软件登陆界面的设计。
界面如下:
登陆界面源代码:
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

 
阅读(3414) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~