GPS应用软件 MapX历史轨迹回放(2)-GPSUU-GPS之家

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '清除临时图层
Dim i As Integer

    For i = 1 To HistoryMap.Layers.Count
        If HistoryMap.Layers.Item(i).Name = TempLayer Then
            HistoryMap.Layers.Remove i
            i = HistoryMap.Layers.Count + 1
        End If
    Next i
    Set Lyr = Nothing
    Set Flds = Nothing
    Set LayerInfo = Nothing
End Sub

Private Sub Form_Resize()

    If Me.WindowState = 1 Then Exit Sub
    HistoryMap.Height = Me.ScaleHeight - 300 - frFrame.Height
    HistoryMap.Width = Me.ScaleWidth
    HistoryMap.Left = Me.ScaleLeft
    frFrame.Width = Me.ScaleWidth
    StatusBar.Panels(1).Width = 350
    StatusBar.Panels(2).Width = (Me.ScaleWidth - 400) / 10 * 4
    StatusBar.Panels(3).Width = (Me.ScaleWidth - 400) / 10 * 3.5
    StatusBar.Panels(4).Width = (Me.ScaleWidth - 400) / 10 * 2.5
    Picture1.Top = Me.ScaleHeight - 330
    Picture1.Left = Me.ScaleLeft + 100
End Sub

Private Sub HistoryMap_DblClick()
    If HistoryMap.CurrentTool = CreateCJTool Then
        HistoryMap.CurrentTool = miArrowTool
        MsgBox 距离： & CStr(DisSum) & 米, vbOKOnly + vbInformation, 测距结果
        StatusBar.Panels(3).Text =
        HisBeginFlag = False
    End If
End Sub

Private Sub HistoryMap_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '测距
    If HistoryMap.CurrentTool = CreateCJTool And Button = vbLeftButton Then
        HistoryMap.MapUnit = miUnitMeter
        HistoryMap.ConvertCoord x, y, xDown, yDown, miScreenToMap
        HisBeginFlag = True
        DisTemp = DisSum 'distemp变量记录历史长度
    End If
End Sub

Private Sub HistoryMap_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim xx As Double, yy As Double
Dim MapCoordX As Double, MapCoordY As Double

    HistoryMap.ConvertCoord x, y, MapCoordX, MapCoordY, miScreenToMap
    If HistoryMap.CurrentTool = CreateCJTool And HisBeginFlag = True Then
        DisSum = DisTemp + HistoryMap.Distance(xDown, yDown, MapCoordX, MapCoordY)
        StatusBar.Panels(3).Text = 距离： & CStr(DisSum) & 米
    End If
    HistoryMap.ConvertCoord x, y, xx, yy, miScreenToMap
    StatusBar.Panels(2).Text = 经度: & CStr(Round(xx, 4)) &      & 纬度: & CStr(Round(yy, 4))
End Sub

Private Sub Slider_Click()
    If Slider.Value <> 0 Then
        Slider.ToolTipText = 回放速度： & Slider.Value * 10 & 倍
        TimerShowMap.Interval = Slider.Value * 10
    End If
End Sub

Private Sub TimerTime_Timer()
    TxtDataTime.Text = CStr(Year(Date)) + 年 + CStr(Month(Date)) + 月 + CStr(Day(Date)) + 日 + + CStr(Hour(Time)) + 时 + CStr(Minute(Time)) + 分 + CStr(Second(Time)) + 秒
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim i As Integer

    Select Case Button.Key
        Case fullmap
            HistoryMap.Bounds = HistoryMap.Layers.Bounds
        Case zoomin
            HistoryMap.CurrentTool = miZoomInTool
        Case zoomout
            HistoryMap.CurrentTool = miZoomOutTool
        Case pan
            HistoryMap.CurrentTool = miPanTool
        Case cj
            HistoryMap.CurrentTool = CreateCJTool
            DisSum = 0
        Case default
            HistoryMap.CurrentTool = miArrowTool
        Case start
            If StopFlag Then
                TimerShowMap.Enabled = True
                Toolbar1.Buttons(10).Enabled = True
                Toolbar1.Buttons(11).Enabled = True
                Toolbar1.Buttons(9).Enabled = False
            Else
                Call BackPutHistoryLocus
            End If
        Case pause
            TimerShowMap.Enabled = False
            Toolbar1.Buttons(9).Enabled = True
            Toolbar1.Buttons(10).Enabled = False
            StopFlag = Not StopFlag
        Case stop
            TimerShowMap.Enabled = False
            Toolbar1.Buttons(10).Enabled = False
            Toolbar1.Buttons(11).Enabled = False
            Toolbar1.Buttons(9).Enabled = True
        Case clear
            TimerShowMap.Enabled = False
            '清除临时图层
            For i = 1 To HistoryMap.Layers.Count
                If HistoryMap.Layers.Item(i).Name = TempLayer Then
                    HistoryMap.Layers.Remove i
                    i = HistoryMap.Layers.Count + 1
                End If
            Next i
            Set Lyr = Nothing
            Set Flds = Nothing
            Set LayerInfo = Nothing
        Case exit
            Unload Me
    End Select
End Sub

Private Sub BackPutHistoryLocus() '回放历史轨迹
Dim ExistFlag As Boolean
Dim i As Integer
Dim TempLyr As MapXLib.Layer

On Error GoTo aa:

'判断临时图层是否存在
    ExistFlag = False '不存在
    For i = 1 To HistoryMap.Layers.Count
        If HistoryMap.Layers.Item(i).Name = TempLayer Then
            ExistFlag = True '存在
            i = HistoryMap.Layers.Count + 1
        End If
    Next i
    (责任编辑：admin)

GPS之家

搜索

热门标签

GPS应用软件 MapX历史轨迹回放(2)