📄 frmgarmin.frm
字号:
Load_EquipmentByGpsID ByVal sGpsID, ByVal sTableName
End Sub
Private Sub Combo2_Click()
'选择设备层
Dim sGpsID As String, sTableName As String
sGpsID = Me.Combo1.Text
sTableName = Me.Combo2.Text
If sGpsID = "" Then Exit Sub
If sTableName = "" Then Exit Sub
'根据GpsID和设备层加载绑定的巡检设备号
Load_EquipmentByGpsID ByVal sGpsID, ByVal sTableName
End Sub
Sub Load_EquipmentByGpsID(ByVal sGpsID As String, ByVal sTableName As String)
Dim strSql As String, n As Integer
Set rs = Nothing
Me.ListView2.ListItems.Clear
strSql = "select B.EquipmentID,B.Name from tbl_EquipmentToGPS as A,tbl_Equipment as B" _
& " where A.EquipmentID=B.EquipmentID and A.TableName=B.TableName and A.GpsID='" _
& sGpsID & "' and A.TableName='" & sTableName & "'"
rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until rs.EOF
n = n + 1
Set lstItem = Me.ListView2.ListItems.Add(, , n)
'lstItem.SubItems(1) = rs("TableName")
lstItem.SubItems(1) = rs("EquipmentID")
lstItem.SubItems(2) = rs("Name")
rs.MoveNext
Loop
rs.Close
End Sub
Private Sub Command1_Click()
Dim strFile As String
On Error GoTo err_lab
With Me.CommonDialog1
.DialogTitle = "打开Garmin数据文件"
.CancelError = False
.Filter = "*.txt|*.txt"
.InitDir = App.Path
.FileName = ""
.ShowOpen
strFile = .FileName
End With
If strFile = "" Then Exit Sub
If Dir$(strFile, vbDirectory) = "" Then Exit Sub
Me.Text1.Text = strFile
' Dim sDirPath As String
' sDirPath = ReturnDirPath(strFile)
' 'Debug.Print sDirPath
' Me.Text2.Text = sDirPath
Exit Sub
err_lab:
MsgBox Err.Description, vbInformation, "提示"
End Sub
Private Sub Command2_Click()
'//处理garmin数据文件
Dim sGpsID As String
Dim sFile As String
Dim tpCount As Double
sGpsID = Me.Combo1.Text
sGpsID = "0001" '????????为什么要设置为0001
sFile = Me.Text1.Text
''######################刘登杰
If sFile = "" Then '防止指定文件为空而无法打开
MsgBox "请指定数据文件!", vbInformation + vbOKOnly, "提示"
Exit Sub
End If
''######################刘登杰
Me.StatusBar1.SimpleText = "正在处理数据..."
tpCount = DealWith_GarminData_Trackpoint(sGpsID, sFile, Me.ListView1)
Me.StatusBar1.SimpleText = "数据处理完毕,共处理 " & tpCount & " 个航迹点。"
''################刘登杰
bchuli = True
''################刘登杰
End Sub
Private Sub Command3_Click()
''################刘登杰
If bchuli = False Then
MsgBox "请先进行数据处理!", vbInformation + vbOKOnly, "提示"
Exit Sub
End If
''################刘登杰
'//显示轨迹(打开轨迹临时文件进行布点跟踪)
Dim sFile As String
Dim sGpsID As String, sLine As String
Dim lngLineCount As Long
Dim lngPointNum As Long, dblLat As Double, dblLong As Double, sRecTime As String
Dim TablePath As String
Dim nObject As Long, RecNum As Long
bShowTrackLine = False
sFile = App.Path + "\track.tmp" '???????????????是否是新建一个临时文件:track.tmp
If Dir(sFile, vbDirectory) = "" Then Exit Sub
'判断是否已经打开临时表
If Not IsOpenTable("tmpTrack.tab") Then
TablePath = App.Path + "\tempmap\tmpTrack.tab"
If Dir(TablePath, vbDirectory) = "" Then
CreateTable_TempTrack '创建临时表
End If
OpenTable (TablePath)
End If
TableName = "tmpTrack"
'删除临时表的记录
MapInfo.Do "delete from " & TableName
SaveTable TableName
MapInfo.Do "Pack Table " & TableName & " Graphic Data"
'加载临时图层到当前的
MapInfo.Do "Add Map Layer " & TableName
' SaveTable TableName
' Exit Sub
'处理临时文件后进行布点
Open sFile For Input As #1
Do Until EOF(1)
lngLineCount = lngLineCount + 1
If lngLineCount = 1 Then
Line Input #1, sLine
sGpsID = sLine
End If
Input #1, lngPointNum, dblLat, dblLong, sRecTime
'Debug.Print lngPointNum, dblLat, dblLong, sRecTime
'展点
CreatePoint CSng(dblLong), CSng(dblLat) '参数为经度、纬度
'写入属性值
nObject = Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NROWS & ")"))
MapInfo.Do "Update " & TableName & " set id=" & lngPointNum & ",rectime=""" & sRecTime & """" & ",ObjType=""POINT"" where RowID=" & nObject
'构造坐标数组提供展绘轨迹路线使用
ReDim Preserve mX(lngLineCount)
ReDim Preserve mY(lngLineCount)
mX(lngLineCount) = CSng(dblLong)
mY(lngLineCount) = CSng(dblLat)
Loop
Close #1
'设置轨迹线样式
'画巡检轨迹路线
CreatePLine mX, mY, CInt(lngLineCount), False
'写入属性值
nObject = Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NROWS & ")"))
MapInfo.Do "Update " & TableName & " set id=" & lngPointNum + 1 & ",rectime="""",ObjType=""PLINE"" where RowID=" & nObject
'保存表
SaveTable TableName
'MapInfo.Do "AutoLabel Layer " & TableName & " Overlap on Duplicates on"
'显示范围:临时层
MapInfo.Do "Set Map Zoom Entire Layer " & TableName
bShowTrackLine = True
End Sub
Private Sub Command4_Click()
''''''''''''###################刘登杰
'退出之前关闭无用的表,QUERY系列
Dim mapWinID As Long, nLayerName As Integer, I As Integer, j As Integer
Dim LayerName As String
For j = 1 To 10 '默认存在的不会超过10个QUERY系列表
TableName = "Query" & j
mapWinID = CLng(MapInfo.Eval("FrontWindow()"))
If mapWinID = 0 Then Exit Sub '??????
nLayerName = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & ",9)"))
For I = 1 To nLayerName
LayerName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & I & ",1)")
If (InStr(LayerName, TableName) > 0) Then
MapInfo.Do "Close Table " & TableName
End If
Next I
Next j
''''''''''''###################刘登杰
'退出时系统自动删除临时层后保存
'清除巡检路线
TableName = "tmpTrack"
If IsOpenTable(TableName) Then
'删除临时表的记录
MapInfo.Do "Delete From " & TableName
SaveTable TableName
MapInfo.Do "Pack Table " & TableName & " Graphic Data" '紧缩表
'关闭表文件
MapInfo.Do "Close Table " & TableName
End If
Unload Me
End Sub
Private Sub Command5_Click()
'巡检分析
Dim SearchTable As String
Dim mBufferDistince As Single '缓冲距离(米)
Dim lngSelectCount As Long
Dim I As Integer, j As Integer, EquipmentCount As Integer, n As Integer
Dim RecNum As Long
Dim X, Y As Double
Dim iEquipmentID As Integer
Dim dArea1 As Double, dArea2 As Double
If Not bShowTrackLine Then
MsgBox "巡检分析前先进行显示轨迹操作!", vbInformation, "提示"
Exit Sub
End If
mBufferDistince = CSng(Me.NumericText1.pText)
If mBufferDistince = 0 Then
MsgBox "缓冲半径不能为0,请重新输入值!", vbInformation, "提示"
Exit Sub
End If
'保存缓冲半径
Set_ProfileStringINI "Project", "Buffer", CStr(mBufferDistince), App.Path + "\ProCFG.INI"
SearchTable = Me.Combo2.Text
If SearchTable = "" Then
MsgBox "没有确定巡检设备层!", vbInformation, "提示"
Exit Sub
End If
'判断巡检设备层是否打开
If Not IsOpenTable(SearchTable) Then
MsgBox "没有找到巡检设备层,请打开图层后再进行巡检分析操作!", vbInformation, "提示"
Exit Sub
End If
EquipmentCount = Me.ListView2.ListItems.Count
''##########################刘登杰
'如果GPS终端号对应的巡检设备个数为0,退出巡检
If EquipmentCount = 0 Then
MsgBox "当前GPS终端号(" & Me.Combo1.Text & ")要求巡检设备点个数为 0 ,请重新匹配!", vbOKOnly, "提示"
Exit Sub
End If
''##########################刘登杰
TableName = "tmpTrack"
'1.先从临时层里提出:轨迹路线
MapInfo.Do "select * from " & TableName & " where ObjType=""PLINE"" into Selection"
'MapInfo.Do "Set Style Brush MakeBrush(15,16762032,14737632)"
MapInfo.Do "Set Style Brush MakeBrush(15,16762032,14737632)"
'2.进行缓冲
MapInfo.Do ("Create Object As Buffer from Selection Into Variable OBJ_Buffer Width " & mBufferDistince & " Units ""m""")
MapInfo.Do "Insert Into " & TableName & "(Object) values (OBJ_Buffer)"
'3.进行重合度分析(点、线、面设备)
If Me.Option1(0).Value = True Then
'1)缓冲区域内所包括的巡检设备点的数量
MapInfo.Do "select obj from " & SearchTable & " where obj Entirely Within OBJ_Buffer"
lngSelectCount = Val(MapInfo.Eval("SelectionInfo(3)")) '返回选中对象的个数
'Debug.Print lngSelectCount
For I = 1 To lngSelectCount
iEquipmentID = MapInfo.Eval(SearchTable & ".设备号")
'Debug.Print iEquipmentID
'根据设备号判别巡检的设备
For j = 1 To EquipmentCount
If UCase$(iEquipmentID) = ListView2.ListItems(j).SubItems(1) Then
n = n + 1
ListView2.ListItems(j).SubItems(3) = "通过"
Exit For
End If
Next
'定位该对象在表中记录位置
MapInfo.Do "Fetch Rec " & I + 1 & " From Selection"
Next
Me.Text2.Text = "当前GPS终端号(" & Me.Combo1.Text & ")要求巡检设备点" _
& EquipmentCount & "个,共巡检通过" & n & "个,巡检率为 " _
& Format((n / EquipmentCount) * 100, "#.##") & "%。"
ElseIf Me.Option1(1).Value = True Then
'2)缓冲区域与巡检设备线路的缓冲区域的叠加重合度
MapInfo.Do "select obj from " & SearchTable & " into Selection"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -