📄 ly_gsm_gps.ctl
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.UserControl Ly_Gsm_Gps
ClientHeight = 4020
ClientLeft = 0
ClientTop = 0
ClientWidth = 4695
Picture = "Ly_Gsm_Gps.ctx":0000
ScaleHeight = 4020
ScaleWidth = 4695
ToolboxBitmap = "Ly_Gsm_Gps.ctx":911C
Begin VB.Timer Tmr_Gps_Call
Enabled = 0 'False
Left = 1320
Top = 2040
End
Begin VB.Timer Tmr_Gps_Refresh
Enabled = 0 'False
Left = 720
Top = 2040
End
Begin VB.Timer Tmr_GsmInfo
Enabled = 0 'False
Left = 120
Top = 2040
End
Begin MSCommLib.MSComm Com_Gsm
Left = 120
Top = 2520
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
RThreshold = 1
RTSEnable = -1 'True
SThreshold = 1
End
Begin MSCommLib.MSComm Com_Gps
Left = 1080
Top = 2520
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = -1 'True
RThreshold = 1
RTSEnable = -1 'True
BaudRate = 19200
SThreshold = 1
InputMode = 1
End
End
Attribute VB_Name = "Ly_Gsm_Gps"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Public GsmPort As Integer 'Gsm 串口
'Public GpsPort As Integer 'Gps 串口
'Public GsmPortOpen As Boolean 'Gsm 串口开关
'Public GpsPortOpen As Boolean 'Gps 串口开关
'Public GsmPortSettings As String 'Gsm 串口设置
'Public GpsPortSettings As String 'Gps 串口设置'
'Public Gsm_Sms_CSCA As String 'Gsm 短消息中心号码
'Public Gsm_Info_Refresh As Integer 'Gsm 信息的刷新时间
'Public Gps_Type As Integer '0 normal 1 长征卫导 2 other
'Public Gps_Refresh As Integer 'Gps 信息的刷新时间
'Public Comm_Date As Integer '0-15 随机表示串口的数据信息
'缺省属性值:
Const m_def_GpsCall = 60
Const m_def_Gsm_Info_Refresh = 60
Const m_def_GpsPortOpen = 0
Const m_def_Gsm_Sms_AutoDel = 0
Const m_def_GsmPort = 1
Const m_def_GpsPort = 3
Const m_def_GsmPortOpen = 0
'Const m_def_GpsPortOpen = 0
Const m_def_GsmPortSettings = "19200,n,8,1"
Const m_def_GpsPortSettings = "4800,n,8,1"
Const m_def_Gsm_Sms_CSCA = "+8613800539500"
'Const m_def_Gsm_Info_Refresh = 60
'Const m_def_Gsm_Info = "1 26"
Const m_def_Gps_Type = 0
Const m_def_Gps_Refresh = 5
'Const m_def_Comm_Date = 0
Dim Read As Boolean
Dim BAy() As Byte
'属性变量:
Dim m_GpsCall As Integer
Dim m_Gsm_Info_Refresh As Integer
Dim m_GpsPortOpen As Boolean
Dim m_Gsm_Sms_AutoDel As Boolean
Dim m_GsmPort As Integer
Dim m_GpsPort As Integer
Dim m_GsmPortOpen As Boolean
'Dim m_GpsPortOpen As Boolean
Dim m_GsmPortSettings As String
Dim m_GpsPortSettings As String
Dim m_Gsm_Sms_CSCA As String
'Dim m_Gsm_Info_Refresh As Integer
'Dim m_Gsm_Info As String
Dim m_Gps_Type As Integer
Dim m_Gps_Refresh As Integer
'Dim m_Comm_Date As Integer
'事件声明:
Public Event CommDate(Flag As Integer)
Public Event GsmInfo(FlagGsm As Integer, InfoAll As String)
Public Event GpsInfo(FlagDW As Integer, WeiDu As Double, JingDu As Double, GaoDu As Double, SuDu As Double, HangXiang As Double, RiQi As String, ShiJian As String, SYTime As Integer, SYJuli As Integer)
Public Event GsmGetSms(MuBiaoNo As String, Sms_All As String, Time_Date As String, SmsSuoYin As Integer)
'以下几个函数用于时时传送出发信息 使用 ：RaiseEvent Sub名 来激活
'RaiseEvent CommDate
Public Sub Ly_Gsm_Gps_CommDate(Flag As Integer)
End Sub
Public Sub Ly_Gsm_Gps_GsmInfo(FlagGsm As Integer, InfoAll As String)
End Sub
Public Sub Ly_Gsm_Gps_GpsInfo(FlagDW As Integer, WeiDu As Double, JingDu As Double, GaoDu As Double, SuDu As Double, HangXiang As Double, RiQi As String, ShiJian As String, SYTime As Integer, SYJuli As Integer)
End Sub
Public Sub Ly_Gsm_Gps_GsmGetSms(MuBiaoNo As String, Sms_All As String, Time_Date As String, SmsSuoYin As Integer)
End Sub
Private Sub Tmr_Gps_Call_Timer()
Dim AToH As String
Dim LenAToH As Integer
If Gps_Type = 1 Then
'定义动态数组
AToH = "00262643740200000000000000000000004F704570FE010D0A00"
LenAToH = Len(AToH) / 2
ReDim BAy(LenAToH)
Dim i
For i = 1 To LenAToH
BAy(i) = "&h" + Mid(AToH, i * 2 - 1, 2)
Next
If Com_Gps.PortOpen = True Then
Com_Gps.Output = BAy
End If
Else
Tmr_Gps_Call.Enabled = False
End If
End Sub
Private Sub Tmr_Gps_Refresh_Timer()
If Read = True Then
Read = False
Else
Read = True
End If
End Sub
Private Sub UserControl_Initialize()
UserControl.Height = 1530
UserControl.Width = 1770
End Sub
Private Sub UserControl_Resize()
UserControl.Height = 1530
UserControl.Width = 1770
End Sub
Private Sub ShowError()
MsgBox " 运行错误！ 错误内容： " & Err & "..." & vbCrLf & " " & Err.Description, vbInformation, "蓝宇科技 Gsm_Gps (Tel: 0539-8309519)"
'显示错误信息 on error 1 1: showerror
End Sub
Private Sub Com_Gps_OnComm()
On Error GoTo err1
Dim RevDate As String
Select Case Com_Gps.CommEvent
Case comEvReceive
If Read = True Then
RevDate = ""
Dim Buffer As Variant, b1, i
If Gps_Type = 1 Then
Com_Gps.InputMode = 1
Com_Gps.InputLen = 0
Buffer = Com_Gps.Input
For i = LBound(Buffer) To UBound(Buffer)
b1 = Hex(CInt(Buffer(i)))
RaiseEvent CommDate(CInt(10 * Rnd(CInt(Buffer(i)))))
If Len(b1) = 1 Then b1 = "0" & b1
RevDate = RevDate & b1
DoEvents
Next i
Else
Com_Gps.InputMode = 1 'comInputModeBinery
Com_Gps.InputLen = 0
Buffer = Com_Gps.Input
RevDate = (StrConv(Buffer, vbUnicode))
RaiseEvent CommDate(CInt(10 * Rnd(Asc(StrConv(Buffer, vbUnicode)))))
End If
Call GetGPSDate(RevDate)
End If
End Select
Exit Sub
err1:
Call ShowError
End Sub
Private Sub GetGPSDate(GpsCode As String)
'40404570010E07D300340340332E3838370784B72619656EE8000000000000000000
'22E700001FFFF0C350FC0001FE01FF334040C8008E0000154A4750DD0D0A2C
'On Error GoTo err1
Dim a, b, c, d, FlagDW As Integer, WeiDu As Double, JingDu As Double, GaoDu As Double, SuDu As Double, HangXiang As Double, RiQi As String, ShiJian As String, SYTime As Integer, SYJuli As Integer
'Gps_Type = 0
'GpsCode = "$GPGGA,101657,3503.1271,N,11820.9880,E,1,07,1.1,90.3,M,90.3,M,0.0,0000*5C" & vbCrLf & "$GPGSA,A,3,04,07,24,20,28,01,13,05,10,,,,1.8,1.1,1.5*35" & vbCrLf & "$GPGSV,3,1,09,04,60,308,34,07,76,082,43,24,35,274,43,20,22,037,00*77" & vbCrLf & "$GPGSV,3,2,09,28,21,178,37,01,19,078,36,13,20,120,36,05,15,315,35*77" & vbCrLf & "$GPGSV,3,3,09,10,06,219,00,,,,,,,,,,,,*4D" & vbCrLf & "$GPRMC,101657,A,3503.1271,N,11820.9880,E,0.00,0.00,140103,0.0,W*64" & vbCrLf & "$GPGGA,101658,3503.1270,N,11820.9880,E,1,07,1.1,90.5,M,90.5,M,0.0,0000*52" & vbCrLf
If Gps_Type = 1 Then
a = InStr(1, GpsCode, "4040")
b = InStr(1, GpsCode, "0D0A")
If b > a And b > 0 And a > 0 And b - a > 70 Then '合法的gps信息
c = "&H" + Mid(GpsCode, a + 8, 2) + 1 - 1
d = d & c & "-"
c = "&H" + Mid(GpsCode, a + 10, 2) + 1 - 1
d = d & c & "-"
c = "&H" + Mid(GpsCode, a + 12, 4) + 1 - 1
RiQi = d & c
c = "&H" + Mid(GpsCode, a + 16, 2) + 1 - 1
d = c & ":"
c = "&H" + Mid(GpsCode, a + 18, 2) + 1 - 1
d = d & c & ":"
c = "&H" + Mid(GpsCode, a + 20, 2) + 1 - 1
ShiJian = d & c
WeiDu = Left(Str(("&H" + Mid(GpsCode, a + 34, 8) + 1 - 1) / 324000000 * 90), 9)
JingDu = Left(Str(("&H" + Mid(GpsCode, a + 42, 8) + 1 - 1) / 648000000 * 180), 10)
GaoDu = ("&H" + Mid(GpsCode, a + 50, 8) + 1 - 1) / 100
SuDu = ("&H" + Mid(GpsCode, a + 58, 4) + 1 - 1) / 100 * 60 / 1000 * 60
HangXiang = ("&H" + Mid(GpsCode, a + 62, 4) + 1 - 1) / 10
FlagDW = "&H" + Mid(GpsCode, a + 66, 2) + 1 - 1
'd = d & "定位" & c & " "
SYTime = "&H" + Mid(GpsCode, a + 68, 4) + 1 - 1
'd = d & "剩余时间：" & c & " 秒 "
SYJuli = "&H" + Mid(GpsCode, a + 72, 4) + 1 - 1
'd = d & "剩余距离：" & c & " Km "
Dim QiangDu As Integer
QiangDu = "&H" + Mid(GpsCode, a + 76, 2) + 1 - 1
'd = d & "信号强度：" & c & " " & vbCrLf
'c = "&H" + Mid(GpsCode, a + 9, 2) + 1 - 1
'd = d & c & " 月 "
RaiseEvent GsmInfo(QiangDu, " 0539005")
End If
Else
1: a = InStr(1, GpsCode, "$GPRMC,")
b = InStr(a + 1, GpsCode, vbCrLf)
If a > 0 And b > 0 And b - a > 60 Then
c = Mid(GpsCode, a + 7, 6)
ShiJian = CInt(Left(c, 2)) + 8 & ":" & Mid(c, 3, 2) & ":" & Right(c, 2)
WeiDu = CDbl(Mid(GpsCode, a + 16, 9)) / 100#
JingDu = CDbl(Mid(GpsCode, a + 28, 10)) / 100#
d = InStr(a + 24, GpsCode, ",") '经度后面
d = InStr(d + 1, GpsCode, ",") 'E
d = InStr(d + 1, GpsCode, ",")
d = InStr(d + 1, GpsCode, ",")
c = InStr(d + 1, GpsCode, ",") '
SuDu = Mid(GpsCode, d + 1, c - d + 1)
'GoTo 1
d = InStr(d + 1, GpsCode, ",")
d = InStr(d + 1, GpsCode, ",")
c = Mid(GpsCode, d + 1, 6)
RiQi = CInt(Left(c, 2)) & "-" & Mid(c, 3, 2) & "-" & Right(c, 2)
End If
a = InStr(1, GpsCode, "$GPGGA,")
b = InStr(a + 1, GpsCode, vbCrLf)
If a > 0 And b > 0 And b - a > 60 Then
FlagDW = Mid(GpsCode, a + 39, 1)
d = InStr(a + 44, GpsCode, ",")
c = InStr(d + 1, GpsCode, ",")
GaoDu = Mid(GpsCode, d + 1, c - d - 1)
End If
End If
If JingDu > 0 And WeiDu > 0 Then
RaiseEvent GpsInfo(FlagDW, WeiDu, JingDu, GaoDu, SuDu, HangXiang, RiQi, ShiJian, SYTime, SYJuli)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -