⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmgarmin.frm

📁 用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    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 + -