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

    If Not ExistFlag Then '不存在，新建临时图层
        '创建临时图层
        Flds.AddStringField ID, 12

        LayerInfo.Type = miLayerInfoTypeTemp
        LayerInfo.AddParameter NAME, TempLayer
        LayerInfo.AddParameter Fields, Flds

        Set Lyr = HistoryMap.Layers.Add(LayerInfo, 1)

    Else
        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 LayerInfo = Nothing
        '创建临时图层

        Flds.AddStringField ID, 12

        LayerInfo.Type = miLayerInfoTypeTemp
        LayerInfo.AddParameter NAME, TempLayer
        LayerInfo.AddParameter Fields, Flds

        Set Lyr = HistoryMap.Layers.Add(LayerInfo, 1)
    End If


    ReDim Angle(Res.RecordCount - 1)
    ReDim RecordTime(Res.RecordCount - 1)

    Res.MoveFirst

    For i = 0 To Res.RecordCount - 1
        Hispnt.Set Res.Fields(Longitude , Res.Fields(Latitude
        Hispnts.Add Hispnt
        Angle(i) = Res.Fields(angle
        RecordTime(i) = Res.Fields(time
        Res.MoveNext
    Next i
        Icount = 0
        TempPnt.Set Hispnts.Item(1).x, Hispnts.Item(1).y
        TimerShowMap.Enabled = True
        'TimerShowMap.Interval = 100
        Toolbar1.Buttons(10).Enabled = True
        Toolbar1.Buttons(11).Enabled = True
        Toolbar1.Buttons(9).Enabled = False
    Exit Sub
aa:
    MsgBox 历史记录回放错误，请检测., vbOKOnly + vbExclamation, 历史记录回放...
    Exit Sub
End Sub

Private Sub TimerShowMap_Timer()
Dim NewStyle As New MapXLib.Style
Dim ftr As New Feature
Dim fnt As New StdFont

On Error GoTo aa:

    Icount = Icount + 1
    If Hispnts.Count = Icount Then
        TimerShowMap.Enabled = False
        TimerShowMap.Interval = 0
        StopFlag = Not StopFlag
        MsgBox 历史轨迹回放完毕!
        Exit Sub
    End If
    With fnt
        .Name = gisdisplay
        .Bold = False
    End With

    With NewStyle
        .SymbolType = miSymbolTypeTrueTypeFont
        .SymbolFont = fnt
        .SymbolFontShadow = True
        .SymbolCharacter = 34
        .SymbolFont.Size = 12
        .SymbolFontColor = gisBlue    '蓝色
    End With

    StatusBar.Panels(3).Text = 第 & CStr(Icount) & 条   & CStr(Round(Hispnts.Item(Icount).x, 4)) & :::: & CStr(Round(Hispnts.Item(Icount).y, 4)) &    方位角: & CStr(Angle(Icount)) & 度
    txtRecordTime.Text = RecordTime(Icount - 1)
    If Icount <> 1 And TempPnt.x = Hispnts.Item(Icount).x And TempPnt.y = Hispnts.Item(Icount).y Then
        TempPnt.Set Hispnts.Item(Icount).x, Hispnts.Item(Icount).y
        Exit Sub
    End If
    ftr.Attach HistoryMap
    ftr.Type = miFeatureTypeSymbol
    ftr.Style = NewStyle
    ftr.Offset Hispnts.Item(Icount).x, Hispnts.Item(Icount).y
    HistoryMap.Layers(TempLayer .AddFeature ftr

    TempPnt.Set Hispnts.Item(Icount).x, Hispnts.Item(Icount).y

    If Hispnts.Item(Icount).x > HistoryMap.Bounds.XMax Then
        HistoryMap.CenterX = Hispnts.Item(Icount).x
        HistoryMap.CenterY = Hispnts.Item(Icount).y
    End If
    If Hispnts.Item(Icount).x < HistoryMap.Bounds.XMin Then
        HistoryMap.CenterX = Hispnts.Item(Icount).x
        HistoryMap.CenterY = Hispnts.Item(Icount).y
    End If
    If Hispnts.Item(Icount).y > HistoryMap.Bounds.YMax Then
        HistoryMap.CenterX = Hispnts.Item(Icount).x
        HistoryMap.CenterY = Hispnts.Item(Icount).y
    End If
    If Hispnts.Item(Icount).y < HistoryMap.Bounds.YMin Then
        HistoryMap.CenterX = Hispnts.Item(Icount).x
        HistoryMap.CenterY = Hispnts.Item(Icount).y
    End If
    Exit Sub
aa:
    TimerShowMap.Enabled = False
    TimerShowMap.Interval = 0
    StopFlag = Not StopFlag
    MsgBox 历史轨迹回放完毕!
    Exit Sub
End Sub(责任编辑：admin)

GPS之家

搜索

热门标签

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