frmgps_jc.frm

用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的

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 = "打开GPS监测数据文件"
        .CancelError = False
        .Filter = "*.txt|*.txt|*.ht|*.ht"
        .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
    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"
    sFile = Me.Text1.Text
    
     ''######################刘登杰
    If sFile = "" Then '防止指定文件为空而无法打开
    MsgBox "请指定数据文件！", vbInformation + vbOKOnly, "提示"
    Exit Sub
    End If
    ''######################刘登杰
    
    Me.StatusBar1.SimpleText = "正在处理数据..."
    tpCount = DealWith_Gps_Trackpoint(sGpsID, sFile, Me.ListView1)
    Me.StatusBar1.SimpleText = "数据处理完毕，共处理 " & tpCount & " 个航迹点。"
  
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
    
    sFile = App.Path + "\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"

'    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 "Add Map Layer " & 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()
    '退出时系统自动删除临时层后保存
    '清除巡检路线
    TableName = "tmpTrack"
    If IsOpenTable(TableName) Then
        '删除临时表的记录
        MapInfo.do "delete from " & TableName
        SaveTable TableName
        MapInfo.do "Pack Table " & TableName & " Graphic Data"
    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
    
    Dim dXJ_Check As Single '巡检率\重合度
    
    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 & ".设备号")
            ' 不明白：为什么在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          'j,,,,EquipmentCount
            
            '定位该对象在表中记录位置
            MapInfo.do "Fetch Rec " & I + 1 & " From Selection"
            
        Next              'i,,,,lngSelectCount
        If n = 0 Then
            dXJ_Check = 0
        Else
            dXJ_Check = Format((n / EquipmentCount) * 100, "#.##")
        End If
        Me.Text2.Text = "当前GPS终端号(" & Me.Combo1.Text & ")要求巡检设备点" _
                & EquipmentCount & "个，共巡检通过" & n & "个，巡检率为 " _
                & dXJ_Check & "%。"
                
''        '''''###############刘登杰----06年1月
'        '添加可视化功能：在巡检缓冲区内的用一种符号标识
'        '不在的用另一种符号标识    （用颜色区分）
'        '创建新的填充样式
'        MapInfo.do "Set Style Brush MakeBrush(10,16762032,14737632)"
'
'        '找出不在缓冲区内的目标
'        MapInfo.do "select obj from " & SearchTable & " where obj <> all (select obj from " & SearchTable & " where obj entriely without obj_buffer)"
'
'''        MapInfo.do "select obj from " & SearchTable & " where not obj  Entirely Without  OBJ_Buffer"
'
'        lngSelectCount = Val(MapInfo.Eval("SelectionInfo(3)"))
'        For I = 0 To lngSelectCount
'


''        '''''###############刘登杰----06年1月
        
    ElseIf Me.Option1(1).Value = True Then
        '2)缓冲区域与巡检设备线路的缓冲区域的叠加重合度
        MapInfo.do "select obj from " & SearchTable & " into Selection"
        lngSelectCount = Val(MapInfo.Eval("SelectionInfo(3)"))

'        MapInfo.Do "Set Style Brush MakeBrush(15,16762032,14737632)"
        MapInfo.do "Set Style Brush MakeBrush(1,8421504,14737632)"
        '应该是对每个对象进行缓冲在进行叠加
         MapInfo.do "Fetch First From Selection"
        For I = 1 To lngSelectCount
            '巡检设备的缓冲
            MapInfo.do "OBJ_Temp1=Selection.OBJ"
            MapInfo.do ("OBJ_Buffer1=Buffer(OBJ_Temp1,20," & mBufferDistince & ",""m"")")
            MapInfo.do "Insert Into " & TableName & "(Object) values (OBJ_Buffer1)"
                        
            '求重合度
            MapInfo.do ("OBJ_Intersect=Overlap( OBJ_Buffer,OBJ_Buffer1)")
            dArea1 = MapInfo.Eval("Area(OBJ_Intersect,""sq km"")")
            dArea2 = MapInfo.Eval("Area(OBJ_Buffer,""sq km"")")
            
            If dArea1 > 0 Then
                MapInfo.do "Set Style Brush MakeBrush(15,8421504,14737632)"
                MapInfo.do "Insert Into " & TableName & "(Object) values (OBJ_Intersect)"
                MapInfo.do "Set Style Brush MakeBrush(1,8421504,14737632)"
                '根据设备号判别巡检的设备
                For j = 1 To EquipmentCount
                
                    iEquipmentID = MapInfo.Eval(SearchTable & ".设备号")
                    If UCase$(iEquipmentID) = ListView2.ListItems(j).SubItems(1) Then
                        n = n + 1
                        ListView2.ListItems(j).SubItems(3) = "重合度:" & Format(dArea1 / dArea2 * 100, "#.##") & "%"
                        Exit For
                    End If
                Next