frmshowtrack.frm

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

    End If
'    mDate1 = Format(Me.DTPicker1(0).Value, "YYYY-MM-DD")

     mDate1 = Me.DTPicker1(0).Value
    mTime1 = Format(Me.DTPicker1(1).Value, "HH:MM:SS")
'    mDate2 = Format(Me.DTPicker2(0).Value, "YYYY-MM-DD")
    mDate2 = Me.DTPicker2(0).Value
    mTime2 = Format(Me.DTPicker2(1).Value, "HH:MM:SS")
    
    sStartTime = CStr(mDate1 & " " & mTime1)
    sEndTime = CStr(mDate2 & " " & mTime2)
    
    'Debug.Print sStartTime, sEndTime
    Close
    Open App.Path + "\Track.tmp" For Output As #1
    
    Print #1, sGpsID
    Set rs = New ADODB.Recordset
   
    strSql = "select * from tbl_Gps_RecData where RecTime Between #" & sStartTime & "# and #" & sEndTime & "#  and gpsid='" & sGpsID & "' order by tpTag"
    
    Debug.Print strSql
    rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    m_TrackCount = rs.RecordCount
    
    Debug.Print m_TrackCount
    If m_TrackCount = 0 Then
        rs.Close
        Close #1
        MsgBox "没有找到符合条件的轨迹数据！", vbInformation, "提示"
        Exit Sub
    End If
    Do Until rs.EOF
        lngPtCount = lngPtCount + 1
        Print #1, lngPtCount, rs("Latitude"), rs("Longitude"), rs("RecTime")
        rs.MoveNext
    Loop
    Close #1
    '------------------------------------------------------------
    '打开临时图层进行轨迹回放操作
    '判断是否已经打开临时表
    Dim TablePath As String
    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
    '-------------------------------------------------------------
    Dim iInterval As Integer
    
    Open App.Path + "\Track.tmp" For Input As #2
    If (50 - Slider1.Value) = 0 Then
        iInterval = 1
    ElseIf (50 - Slider1.Value) = 50 Then
        iInterval = 50
    Else
        iInterval = 50 - Slider1.Value
    End If
'    Me.WindowState = 1
    
    MapInfo.Do "set map Redraw On"
    MapInfo.Do "set map Zoom 0.5"
    
    '符号
    MapInfo.Do "Set Style Symbol MakeSymbol(34,8388608 ,9)"

    Timer1.Interval = iInterval * 40
    Timer1.Enabled = True
    
    Command1.Enabled = False
    Command2.Enabled = True
    Command4.Enabled = False
End Sub

Private Sub Command4_Click()
    '清除巡检路线
    TableName = "tmpTrack"
    If Not IsOpenTable(TableName) Then Exit Sub
    '删除临时表的记录
    MapInfo.Do "delete from " & TableName
    SaveTable TableName
    MapInfo.Do "Pack Table " & TableName & " Graphic Data"
    
    bDeleteTrackLine = True
    
    Me.Command1.Enabled = True
    Me.Command2.Enabled = False
    Me.Command2.Caption = "暂停"
    Timer1.Enabled = False
    
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Cancel = 0
End Sub


Private Sub Slider1_Change()
    Dim iInterval As Integer
    'On Error Resume Next
    Timer1.Enabled = False
    If (50 - Slider1.Value) = 0 Then
        iInterval = 1
    ElseIf (50 - Slider1.Value) = 50 Then
        iInterval = 50
    Else
        iInterval = 50 - Slider1.Value
    End If
    Timer1.Interval = iInterval * 40
End Sub


'时间控制回放的速度
Private Sub Timer1_Timer()
    'Static I As Long
    Dim nObject As Long
    Dim K As Long, dLatitude As Single, dLongitude As Single, sRecTime As String
    Dim m_curLong As Single, m_curLat As Single '当前的点
    On Error GoTo err_lab
    Do Until EOF(2)
        I = I + 1
        If I = 1 Then
            Line Input #2, sGpsID
        Else
            If I = m_TrackCount Then
                Command1.Enabled = True
                Command2.Enabled = False
                Command4.Enabled = True
                Timer1.Enabled = False
                
                m_preLong = 0
                m_preLat = 0
                m_curLong = 0
                m_curLat = 0
                
                I = 0
                
                Close #2
                MsgBox "GPS终端号(" & sGpsID & ")在设定时间段内的轨迹回放完毕！", vbInformation, "提示"
                Exit Sub
            End If
            Input #2, K, dLatitude, dLongitude, sRecTime
            
            'MapInfo.Do "set map Redraw On"
            '展点
            CreatePoint CSng(dLongitude), CSng(dLatitude)  '参数为经度、纬度
            '写入属性值
            nObject = Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NROWS & ")"))
            MapInfo.Do "Update " & TableName & " set ID=" & I & ",rectime=""" & sRecTime & """" & ",ObjType=""POINT"" where RowID=" & nObject
            
            '-----------------------------------------
            '如果点不在当前窗口内,则就改变当前的中心点
            If Not bInPolygon_Window(dLongitude, dLatitude) Then
                MapInfo.Do "Set map Center (" & dLongitude & "," & dLatitude & ")"
            End If
            
            'MapInfo.Do "Set map Center (" & dLongitude & "," & dLatitude & ")"
            'MapInfo.Do "set map Zoom 0.5"
    '        MapInfo.Do "set map Redraw Off"
            '-----------------------------------------
            '展绘轨迹线
            If I = 2 Then
                '绘第一个点
                m_preLong = dLongitude
                m_preLat = dLatitude
            ElseIf I > 2 Then
                '绘第二个点和以后的点
                m_curLong = dLongitude
                m_curLat = dLatitude
                
                '画线(两点间创建直线)
                CreateLine m_preLong, m_preLat, m_curLong, m_curLat
                
                '将当前点记录为前一点
                m_preLong = m_curLong
                m_preLat = m_curLat
            End If
            Exit Do
        End If
    Loop
    Exit Sub
err_lab:
    MsgBox Err.Description, vbCritical, "提示"
End Sub

Private Sub Command2_Click()
    '暂停、继续
    If Command2.Caption = "暂停" Then
        Command2.Caption = "继续"
        Timer1.Enabled = False
        Me.Slider1.Enabled = True
    ElseIf Command2.Caption = "继续" Then
        Command2.Caption = "暂停"
        Timer1.Enabled = True
        Me.Slider1.Enabled = False
    End If
End Sub

Private Sub Command3_Click()
'    If Not bDeleteTrackLine Then
'        '清除巡检路线
'        TableName = "tmpTrack"
'        If Not IsOpenTable(TableName) Then Exit Sub
'        '删除临时表的记录
'        MapInfo.Do "delete from " & TableName
'        SaveTable TableName
'        MapInfo.Do "Pack Table " & TableName & " Graphic Data"
'    End If
    Unload Me
End Sub

Private Sub Form_Load()

  '加载GPSID
    Load_GpsID rs, Me.Combo1
    
    Me.DTPicker1(0).Value = Format(Date, "YYYY-MM-DD")
    Me.DTPicker2(0).Value = Format(Date, "YYYY-MM-DD")
    
    Me.Top = 1200
    Me.Left = Screen.Width - Me.Width - 30
    
    Command2.Enabled = False
    Command4.Enabled = False
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState = 1 Then Exit Sub
    Me.Height = 3660
    Me.Width = 4635
End Sub