一个地图编辑工具


 本节内容可以参考CaseStudy目录下的文件"地图.Table"的示例三十五。

提示： 普通用户不用研究本示例的代码，将其当做一个强大的地图编辑工具直接使用即可。

如果你想在离线地图上绘制某未知名的河流或道路的走向，或某个乡镇(或村)的大概范围，或临时决定勾画某区域(例如受灾范围)，那么如何获得目标的经纬度数据呢？

有些目标的经纬度数据，是可以通过第三方服务获取的，但有些事没有办法的。

此时你可以打开本节的示例(建议实际使用的时候，地图源采用高德地图)，然后找到目标，例如某条河流，然后沿着河流走向绘制一条线，即可得到该河流的经纬度数据。

你需要更高精度的数据时，放大地图进行绘制，需要更粗略的数据时，缩小地图进行绘制。

 这个工具可以将编辑结果保存在数据表中（类似示例文件中的行政区域表）， 大家可以在这个工具的基础上进行扩展，例如加上颜色和宽度的选择以及标题的设置。

这是示例的代码量有500行，是Foxtable代码量最大的一个示例，而且不同的事件代码之间环环相扣，如果你理解起来有困难，是再正常不过了，真的没必要去死扣，直接套用就行了。

如前所言，本示例是一个很重要的工具，原本是要直接内置在Map控件中的，但这样的话用户扩展不方便，同时我们也想给高端用户提供一个开发复杂功能的示例，于是将这部分代码提炼出来做成了一个Foxtable项目。

如果你能理解消化好这个例子，对于你今后的开发肯定是有益的，但千万不要勉强。

本节的任务模仿阿里云的在线地图编辑器：

https://datav.aliyun.com/portal/school/atlas/area_generator

用Foxtable开发一个可以在地图上任意编辑涂鸦的工具：

1、可以插入 标记、线条、四边形、多边形和圆形

2、可以随意移动形状

3、可以随意调整现有形状

4、可以随意旋转现有形状

5、对于线条和多边形，可以在任意位置插入或删除顶点：

下面是本示例的完整代码，代码有详尽的注释，请自行研究理解消化：

1、窗口AfterLoad事件代码：

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As New VectorLayer()
map.Layers.Add(layer)
layer.Style.Stroke.Color = Color.LightGray
layer.LabelVisibility = LabelVisibility.Visible
map.Viewport.Margin = New Padding(0, 32, 0, 0) '地图上方留空32个像素用于放置按钮
'提前准备全局变量
Vars("CurrentButton") = "btnSelect" '用Var变量记录当前按钮
e.Form.Controls("btnSelect").Theme = "GreenHouse" ' 当前按钮用不同的样式标记
Vars("GeoPointsClicked") = New List(Of GeoPoint) '一个集合，用于收集绘制形状过程中，用户点击鼠标确认的位置点
Vars.Add("DataRowToDraw", GetType(DataRow), Nothing) '调用绘制按钮绘制形状时，要先将数据行存储在这个Var变量中
Vars.Add("VectorItemDrawn", GetType(VectorItem), Nothing) '用绘制按钮绘制完成的形状，将存储在这个Var变量中，方便调用者使用
Vars.Add("TempVectorItem", GetType(VectorItem), Nothing) '用于存储在涂鸦过程中生成的临时形状
Vars.Add("VectorItemSelected", GetType(VectorItem), Nothing) '用于存储当前选中的形状
Vars.Add("TipMark", GetType(VectorPlacemark), Nothing) '用于存储一个标记，这个标记会在用户绘制形状的过程中，给用户一些动态提示
Vars.Add("StartPoint", GetType(GeoPoint), Nothing) '在拖动或调整形状时，用于记录鼠标的初始位置
Vars("AdjustState") = True '是否处于调整状态
Vars("AdjustMarks") = New List(Of VectorPlacemark) '一个集合，用于收集调整状态下生成的调整标记
Vars.Add("AdjustMark", GetType(VectorItem), Nothing) '用于记录正在拖动的调整标记
'创建用于提示的TipMark标记
Dim mark As New VectorPlacemark
mark.Marker.Size = New SizeF(6, 6)
mark.Marker.Shape = MarkerShape.Circle
mark.Style.BackColor = Color.Blue
mark.Style.Stroke.Color = Color.Blue
mark.LabelStyle.ForeColor = Color.RosyBrown
mark.Marker.LabelPosition = LabelPosition.Top
mark.Visible = False
layer.Items.Add(mark)
Vars("TipMark") = mark
'绘制省级行政区作为背景，如果需要高精度的绘制，可以用高德地图作为背景
For Each dr As DataRow In DataTables("行政区域").Select("level= 1")
    layer.Items.Add(map.CreatePolygon(dr("geometry")))
Next
'绘制用户之前涂鸦好的形状
For Each dr As DataRow In DataTables("涂鸦").DataRows
    Vars("DataRowToDraw") = dr
    e.Form.Controls("btnDrawItem").PerformClick()
Next

2、窗口全局Click事件代码：

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
map.Focus()
Dim layer As VectorLayer = map.Layers(0)
Select Case e.Sender.Name
    Case "btnSelect", "btnMark", "btnLine", "btnPolygon", "btnCircle", "btnRectangle"
        e.Form.Controls("btnUnSelect").PerformClick() '取消之前选择的形状
        e.Form.Controls(Vars("CurrentButton")).Theme = "(default)" '前一个当前按钮恢复默认样式
        Vars("CurrentButton") = e.Sender.Name '将单击的按钮设置为当前按钮
        e.Sender.Theme = "GreenHouse" '改变当前按钮的样式
        Vars("GeoPointsClicked").Clear() '清除绘制中添加的临时位置点，如果有的话
        Vars("VectorItemDrawn") = Nothing '从Var变量中清除刚刚绘制的形状，如果有的话
        If Vars("TempVectorItem") IsNot Nothing Then '移除临时绘制的形状，如果有的话
            layer.Items.Remove(Vars("TempVectorItem"))
            Vars("TempVectorItem") = Nothing
        End If
        Dim tipMark As VectorPlacemark = Vars("TipMark")
         tipMark.Visible = (e.Sender.Name <> "btnSelect") '如果当前按钮是"选择"，则隐藏提示标记
        Select Case e.Sender.Name '不同的当前按钮，显示不同的提示内容
            Case "btnMark"
                tipMark.Marker.Caption = "单击放置标记"
            Case "btnLine", "btnRectangle", "btnPolygon"
                tipMark.Marker.Caption = "单击放置首点"
            Case "btnCircle"
                tipMark.Marker.Caption = "单击放置圆心"
        End Select
End Select

3、"可调"按钮代码：

Vars("AdjustState") = Not Vars("AdjustState") '切换可调状态
If Vars("AdjustState") Then '如果是可调状态
    e.Sender.Theme = "GreenHouse" '改变按钮样式
Else
    e.Sender.Theme = "(default)" '否则恢复默认样式
End If
If Vars("CurrentButton") <> "btnSelect" Then '如果当前按钮不是"选择"
    e.Form.Controls("btnSelect").PerformClick() '则模拟单击选择按钮
End If
e.Form.Controls("btnDrawAdjustMarks").PerformClick() '绘制(或清除)调整标记

4、"旋转"按钮代码：

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
If Vars("VectorItemSelected") IsNot Nothing Then
    Dim ItemSelected As VectorItem = Vars("VectorItemSelected") '获取选择的形状  
    Dim dr As DataRow = ItemSelected.Tag '获取形状对应的数据行
    If dr("类型") = "Mark" OrElse dr("类型") = "Circle" Then '标记和旋转没有必要旋转
        Return
    ElseIf dr("类型") = "Rectangle" Then '平行四边形其实也没有旋转的必要，如果要旋转，要先转换为普通多边形才行
        Dim ps() As String = dr("数据").Split(",")
        dr("类型") = "Polygon"
        dr("数据") = ps(0) & "," & ps(1) & "," & ps(0) & "," & ps(3) & "," & ps(2) & "," & ps(3) & "," & ps(2) & "," & ps(1)
    End If
    Dim angle As Integer = 30 '默认顺时钟旋转30度
    If ModifierKey = Keys.Shift Then '如果按住了Shift键
        angle = -30 '则逆时钟旋转30度
    End If
    dr("数据") = map.RolateGeoPointString(dr("数据"), angle) '直接针对数据进行旋转计算
    Vars("DataRowToDraw") = dr '然后根据新数据绘制形状
    e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮生成并绘制一个新形状
    Dim itemNew As VectorItem = Vars("VectorItemDrawn") '获得刚刚生成的新形状
    itemNew.Style.Stroke.Color = ItemSelected.style.Stroke.Color '新形状和原形状的边框被背景颜色一致
    itemNew.Style.BackColor = ItemSelected.Style.BackColor
    layer.Items.Remove(ItemSelected) '移除原形状
    Vars("VectorItemSelected") = itemNew '将新形状设置为选中
    e.Form.Controls("btnDrawAdjustMarks").PerformClick() '绘制调整标记    
End If
e.Cancel = True '没必要执行窗口的全局Click事件了

5、"删除"按钮代码:

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
If Vars("VectorItemSelected") IsNot Nothing Then
    Dim ItemSelected As VectorItem = Vars("VectorItemSelected") '获取选择的形状  
    Dim dr As DataRow = ItemSelected.Tag '获取形状对应的数据行
    dr.Delete() '删除数据行
    e.Form.Controls("btnUnSelect").PerformClick() '模拟取消选择
    layer.Items.Remove(ItemSelected) '移除形状
    Vars("VectorItemSelected") = Nothing
    Vars("StartPoint") = Nothing
End If
e.Form.Controls("btnSelect").PerformClick() '模拟单击选择按钮
e.Cancel = True '已经没必要执行窗口的全局Click事件了

6、Map控件的MouseClick事件代码：

Dim map As GeoMap = e.Sender.GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim curPoint As GeoPoint = map.MouseGeoPosition '获取鼠标位置
Dim tipMark As VectorPlacemark = Vars("TipMark") '获取提示标记
Dim gps As List(Of GeoPoint) = Vars("GeoPointsClicked") '获取之前单击确认的位置点
Select Case vars("CurrentButton") '根据当前按钮判断要绘制的形状类型
    Case "btnMark" '绘制标记
        Dim dr As DataRow = DataTables("涂鸦").AddNew
        dr("类型") = "Mark"
        dr("数据") = curPoint.X & "," & curPoint.y
        dr.Save()
        Vars("DataRowToDraw") = dr '将数据行存在Var变量中，方便绘制按钮调用
        e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮绘制标记
    Case "btnLine", "btnPolygon" '对于线条或多边形，单击只是添加位置点，完成绘制需要双击
        gps.Add(curPoint)
        If vars("CurrentButton") = "btnLine" OrElse gps.Count >= 2 Then
            tipMark.Marker.Caption = "单击继续,双击结束"
        Else
            tipMark.Marker.Caption = "单击继续"
        End If
    Case "btnRectangle" '绘制四边形
        If gps.Count = 0 Then
            gps.Add(curPoint)
            tipMark.Marker.Caption = "单击确定对角点"
        Else
            Dim p1 As GeoPoint = gps(0)
            Dim p2 As GeoPoint = curPoint
            Dim dr As DataRow = DataTables("涂鸦").AddNew()
            dr("类型") = "Rectangle"
            dr("数据") = p1.X & "," & p1.Y & "," & p2.X & "," & p2.Y
            dr.Save()
            Vars("DataRowToDraw") = dr
            e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮绘制四边形
            e.Form.Controls("btnRectangle").PerformClick() '继续绘制下一个
        End If
    Case "btnCircle"
        If gps.Count = 0 Then
            gps.Add(curPoint)
            tipMark.Marker.Caption = "单击确定半径"
        Else
            Dim p1 As GeoPoint = gps(0)
            Dim p2 As GeoPoint = curPoint
            Dim dr As DataRow = DataTables("涂鸦").AddNew()
            dr("类型") = "Circle"
            dr("数据") = p1.X & "," & p1.Y & "," & p2.X & "," & p2.Y
            dr.Save()
            Vars("DataRowToDraw") = dr
            e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮绘制圆形
            e.Form.Controls("btnCircle").PerformClick() '继续绘制下一个
        End If
End Select

7、Map控件的DoubleClick事件代码：

Dim map As GeoMap = e.Sender.GeoMap
Dim layer As VectorLayer = map.Layers(0)
Select Case Vars("CurrentButton")
    Case "btnLine", "btnPolygon"
        Dim gps As List(Of GeoPoint) = Vars("GeoPointsClicked")
        If gps.Count > 2 OrElse (gps.Count = 2 AndAlso vars("CurrentButton") = "btnLine") Then '线条至少两个点，多边形至少三个点
            Dim sb As New StringBuilder() '将经纬度数据转成字符串形式
            For Each gp As GeoPoint In gps
                sb.Append(gp.X & "," & gp.Y & ",")
            Next
            Dim dr As DataRow = DataTables("涂鸦").AddNew()
            If vars("CurrentButton") = "btnLine" Then
                dr("类型") = "Line"
            Else
                dr("类型") = "Polygon"
            End If
            dr("数据") = sb.ToString().Trim(",")
            dr.Save()
            Vars("DataRowToDraw") = dr '准备根据这一行绘制形状
            e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮绘制形状
            e.Form.Controls(Vars("CurrentButton")).PerformClick() '继续绘制下一个
        End If
End Select

8、Map控件的MouseDown事件代码：

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim ifo As HitTestInfo = map.HitTest(e.Sender.MousePosition)
If Vars("CurrentButton") = "btnSelect" Then
    If ifo IsNot Nothing AndAlso ifo.Vector IsNot Nothing Then
        If TypeOf ifo.Vector.tag Is DataRow Then
            vars("AdjustMark") = Nothing '按下的是形状本身，而不是调整标记，所以将调整标记设置为Nothing
            Vars("StartPoint") = map.MouseGeoPosition() '记录鼠标开始位置
            If Vars("VectorItemSelected") IsNot ifo.Vector Then '如果选择的是之前选定的形状
                e.Form.Controls("btnUnSelect").PerformClick() '取消之前选择的形状
                Vars("VectorItemSelected") = ifo.Vector '选中此形状
                ifo.Vector.Style.Stroke.Color = Color.Red '改变此形状的样式：
                If TypeOf ifo.Vector Is VectorPlacemark Then
                    ifo.Vector.Style.BackColor = Color.Red
                ElseIf TypeOf ifo.Vector Is VectorPolygon Then
                    ifo.Vector.Style.BackColor = Color.FromArgb(38, 255, 0, 0)
                End If
                e.Form.Controls("btnDrawAdjustMarks").PerformClick()
            End If
            Return
        ElseIf ifo.Vector.tag = "adjust" Then
            Dim mark As VectorPlacemark = vars("AdjustMark")
            If mark IsNot Nothing Then '复原当前调整标记的样式
                mark.Style.BackColor = Color.Red
                mark.Style.Stroke.Color = Color.Red
            End If
            vars("AdjustMark") = ifo.Vector '将单击的调整标记设置为当前调整标记
            Vars("StartPoint") = map.MouseGeoPosition() '记录鼠标开始位置
            ifo.Vector.Style.BackColor = Color.Blue '当前调整标记要有不同的样式
            ifo.Vector.Style.Stroke.Color = Color.Blue
            Return
        End If
    End If
    e.Form.Controls("btnUnSelect").PerformClick() '取消之前选择的形状
End If

9、Map控件的MouseMove事件代码：

If e.Button = MouseButtons.Left Then '如果移动过程按下了鼠标左键
    If Vars("CurrentButton") = "btnSelect" Then '且当前按钮为"选择"
        If Vars("AdjustMark") IsNot Nothing Then '如果拖动的是调整标记
            e.Form.Controls("btnAdjust").PerformClick() '调用调整按钮，调整形状打下和位置
        Else
            e.Form.Controls("btnMove").PerformClick() '调用移动按钮移动形状
        End If        
    End If
    Return '退出
End If
Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim tipMark As VectorPlacemark = Vars("TipMark")
If tipMark.Visible Then '提示标记跟随鼠标移动
    tipMark.Geometry = map.MouseGeoPosition
End If
Select Case vars("CurrentButton")
    Case "btnLine", "btnPolygon", "btnCircle", "btnRectangle"
        '调用"临时绘制"按钮绘制一个临时形状，用于告知用户你即将绘制的形状是怎样的
        '绘制过程可以按Esc键取消
        e.Form.Controls("btnTempDraw").PerformClick()
End Select

10、Map控件的MouseMove事件代码：

Vars("StartPoint") = Nothing '清除鼠标起始位置

11、Map控件的KeyDown事件：

If e.KeyCode = keys.Escape Then
     e.Form.Controls("btnSelect").PerformClick()
 ElseIf e.KeyCode = Keys.Delete Then
     e.Form.Controls("btnDelete").PerformClick()
End If

12、调整形状(btnAdjust)按钮代码：

If Vars("VectorItemSelected") Is Nothing OrElse Vars("StartPoint") Is Nothing OrElse Vars("AdjustMark") Is Nothing Then
    Return
End If
Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
'移动调整标记到鼠标位置，然后根据所有标记的位置计算得出形状的经纬度数据(字符串形式)
Dim mark As VectorPlacemark = Vars("AdjustMark")
mark.Geometry = map.MouseGeoPosition '将调整标记移到新位置
Dim sb As New StringBuilder()
Dim marks As List(Of VectorPlacemark) = Vars("AdjustMarks")
For Each mark In marks
    Dim pt As GeoPoint = mark.Geometry
    If sb.Length > 0 Then
        sb.Append(",")
    End If
    sb.Append(pt.X & "," & pt.Y)
Next
'所谓调整，其实就是根据新数据重新绘制一个形状，并移除原来的形状
Dim itemOld As VectorItem = Vars("VectorItemSelected") '获得选择的形状
layer.Items.Remove(itemOld) '移除原形状
Dim dr As DataRow = itemOld.Tag '获取数据行
dr("数据") = sb.ToString() '保存经纬度数据
Vars("DataRowToDraw") = dr '准备根据新的数据重新生成形状
e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮生成并绘制一个新形状
Dim itemNew As VectorItem = Vars("VectorItemDrawn") '获得刚刚生成的新形状
itemNew.Style.Stroke.Color = itemOld.style.Stroke.Color '新形状和原形状的边框被背景颜色一致
itemNew.Style.BackColor = itemOld.Style.BackColor
Vars("VectorItemSelected") = itemNew '将新形状设置为选中
'确保调整标记始终显示在形状前面：
layer.Items.Remove(itemNew)
layer.Items.Insert(layer.Items.IndexOf(marks(0)), itemNew)

13、移动（btnMove）按钮代码：

'这里的移动，其实就是根据新数据生成一个新形状，并移除原来的形状
If Vars("VectorItemSelected") Is Nothing OrElse Vars("StartPoint") Is Nothing Then
    Return
End If
Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim itemOld As VectorItem = Vars("VectorItemSelected") '获得之前选择的形状
Dim startPoint As GeoPoint = Vars("StartPoint") '获得鼠标起始位置
Dim currentPoint As GeoPoint = map.MouseGeoPosition '获得当前鼠标位置
Dim offsetX As Double = currentPoint.X - startPoint.X '水平位移
Dim OffsetY As Double = currentPoint.Y - startPoint.Y '垂直位移
Dim dr As DataRow = itemOld.Tag '获取形状对应的数据行
Dim vals() As String = dr("数据").ToString().Split(",") '拆分字符型的经纬度数据
Dim sb As New StringBuilder()
For i As Integer = 0 To vals.Length - 1 Step 2 '更新经纬度数据
    If sb.Length > 0 Then
        sb.Append(",")
    End If
    sb.Append(CDbl(vals(i)) + offsetX)
    sb.Append(",")
    sb.Append(CDbl(vals(i + 1)) + offsetY)
Next
dr("数据") = sb.ToString() '保存经纬度数据
Vars("DataRowToDraw") = dr
e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮生成并绘制一个新形状
Dim itemNew As VectorItem = Vars("VectorItemDrawn") '获得刚刚生成的新形状
itemNew.Style.Stroke.Color = itemOld.style.Stroke.Color '新形状和原形状的边框被背景颜色一致
itemNew.Style.BackColor = itemOld.Style.BackColor
layer.Items.Remove(itemOld) '移除原形状
Vars("VectorItemSelected") = itemNew '将新形状设置为选中
Vars("StartPoint") = currentPoint '更新鼠标起始位置
e.Form.Controls("btnDrawAdjustMarks").PerformClick() '绘制调整标记

14、标准绘制（btnDrawItem）按钮代码：

If Vars("DataRowToDraw") Is Nothing Then Return
Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim dr As DataRow = Vars("DataRowToDraw") '获取要绘制的数据行
Vars("DataRowToDraw") = Nothing
Select Case dr("类型")
    Case "Mark" '绘制标记
        Dim mark As VectorPlacemark = map.CreatePlaceMark(dr("数据"))
        mark.Marker.Shape = MarkerShape.Circle
        mark.Style.BackColor = Color.Green
        mark.Style.Stroke.Color = Color.Green
        mark.Marker.Size = New SizeF(6, 6)
        layer.Items.Add(mark)
        mark.Tag = dr
        Vars("VectorItemDrawn") = mark '绘制好的形状存储在var变量中，方便调用者使用
    Case "Line" '绘制线条
        Dim line As VectorPolyline = map.CreateLine(dr("数据"))
        line.Style.Stroke.Color = Color.Green
        line.Style.Stroke.Width = 2
        layer.Items.Add(line)
        line.Tag = dr
        Vars("VectorItemDrawn") = line
    Case "Polygon", "Circle", "Rectangle" '绘制多边形、圆形和四边形
        Dim polygon As VectorPolygon
        If dr("类型") = "Polygon" Then
            polygon = map.CreatePolygon(dr("数据"))
        ElseIf dr("类型") = "Circle" Then
            polygon = map.CreateCircle(dr("数据"), True)
        Else
            polygon = map.CreateRectangle(dr("数据"))
        End If
        polygon.Style.Stroke.Color = Color.Green
        polygon.Style.BackColor = Color.FromArgb(38, 0, 255, 0)
        layer.Items.Add(polygon)
        polygon.Tag = dr
        Vars("VectorItemDrawn") = polygon
End Select

15、绘制临时形状（btnTempDraw）按钮代码：

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim gps As New List(Of GeoPoint) '创建一个临时的位置点集合，避免影响用于正式绘制的数据
gps.AddRange(Vars("GeoPointsClicked")) '将已经确认的位置点添加到临时集合中
gps.Add(map.MouseGeoPosition) '鼠标位置的点要参与绘制，所以也添加到临时集合中
Dim TempVectorItem As VectorItem = Nothing
If gps.Count > 1 Then
    Select Case vars("CurrentButton") '绘制新的临时形状
        Case "btnLine", "btnPolygon"
            TempVectorItem = map.CreateLine(gps)
        Case "btnRectangle"
            TempVectorItem = map.CreateRectangle(gps(0), gps(1))
        Case "btnCircle"
            TempVectorItem = map.CreateCircle(gps(0), gps(1), True)
    End Select
    If TempVectorItem IsNot Nothing Then '设置临时形状的样式
        TempVectorItem.Style.Stroke.Color = Color.RosyBrown
        TempVectorItem.Style.Stroke.Width = 2
        layer.Items.Add(TempVectorItem)
    End If
End If
If Vars("TempVectorItem") IsNot Nothing Then '移除原来的临时形状
    layer.Items.Remove(Vars("TempVectorItem"))
End If
Vars("TempVectorItem") = TempVectorItem '将新的临时形状存储在Var变量中

16、绘制调整标记(btnDrawAdjustMarks)按钮代码:

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim AdjustMarks As List(Of VectorPlacemark) = Vars("AdjustMarks")
For Each mark As VectorPlacemark In AdjustMarks '移除原来的调整标记
    layer.Items.Remove(mark)
Next
If vars("AdjustState") = True AndAlso Vars("VectorItemSelected") IsNot Nothing Then
    Dim curItem As VectorItem = Vars("VectorItemSelected")
    Dim dr As DataRow = curItem.Tag
    If dr("类型") = "Mark" Then Return '标记本身不需要调整标记的，所以退出
    Dim strVals() As String = dr("数据").ToString().Split(",")
    AdjustMarks.Clear() '清除原来的调整标记
    For idx As Integer = 0 To strVals.Length - 2 Step 2 '绘制新的调整标记
        Dim x As Double = CDbl(strVals(idx))
        Dim y As Double = CDbl(strVals(idx + 1))
        Dim mark As New VectorPlacemark
        mark.Tag = "adjust" '将Tag设置为"adjust"，表明这是一个调整标记
        mark.Geometry = New GeoPoint(x, y)
        mark.Marker.Size = New SizeF(8, 8)
        mark.Marker.Shape = MarkerShape.Circle
        mark.Style.BackColor = Color.Red
        mark.Style.Stroke.Color = Color.Red
        layer.Items.Add(mark)
        AdjustMarks.Add(mark)
    Next
End If

17、插入点(btnInsertPoint)按钮代码：

'一个调整标记对应一个点，知道这一点，就很好处理
If Vars("VectorItemSelected") Is Nothing Then
    MessageBox.Show("请先选择一个形状!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
    Return
End If
If Vars("AdjustMark") Is Nothing Then
    MessageBox.Show("请先选择要插入的位置!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
    Return
End If
Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim marks As List(Of VectorPlacemark) = Vars("AdjustMarks") '获取调整标记集合
Dim mark As VectorPlacemark = Vars("AdjustMark") '获取当前调整标记，在该标记之后插入点
Dim insertIndex As Integer '插入位置
Dim startPoint As GeoPoint '将在startPoint和endPoint之间插入
Dim endPoint As GeoPoint
Dim dr As DataRow = Vars("VectorItemSelected").tag '获取数据行
If dr("类型") <> "Line" AndAlso dr("类型") <> "Polygon" Then
    MessageBox.Show("只有线条和多边形才可以插入点!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
    Return
End If
If mark Is marks(0) Then '如果当前点是首点
    If dr("类型") = "Line" Then
        MessageBox.Show("不可以在线条首点之前插入！", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        Return
    Else '多变形是闭环的，首点的前一个点其实就是最后一个点
        startPoint = marks(marks.Count - 1).Geometry
        endPoint = marks(0).Geometry
        insertIndex = 0
    End If
Else '如果不是首点
    For index As Integer = 1 To marks.Count - 1 '遍历确认插入位置
        If marks(index) Is mark Then
            startPoint = marks(index - 1).Geometry
            endPoint = marks(Index).Geometry
            insertIndex = index
            Exit For
        End If
    Next
End If
Dim insertCount As Integer = 1 '插入点数
If InputValue(insertCount, "插入点", "请输入要插入的点数：") = False Then
    Return
End If
For i As Integer = insertCount To 1 Step - 1 '现在开始插入点(其实也是插入调整标记)
    Dim x As Double = startPoint.X + (endPoint.X - startPoint.X) / (insertCount + 1) * i
    Dim y As Double = startPoint.Y + (endPoint.Y - startPoint.Y) / (insertCount + 1) * i
    mark = New VectorPlacemark
    mark.Tag = "adjust" '将Tag设置为"adjust"，表明这是一个调整标记
    mark.Geometry = New GeoPoint(x, y)
    mark.Marker.Size = New SizeF(8, 8)
    mark.Marker.Shape = MarkerShape.Circle
    mark.Style.BackColor = Color.Red
    mark.Style.Stroke.Color = Color.Red
    layer.Items.Add(mark)
    marks.Insert(insertIndex, mark)
Next
'保存经纬度数据：
Dim sb As New StringBuilder()
For Each mark In marks
    Dim pt As GeoPoint = mark.Geometry
    If sb.Length > 0 Then
        sb.Append(",")
    End If
    sb.Append(pt.X & "," & pt.Y)
Next
dr("数据") = sb.ToString()

18、删除点按钮代码：

'一个调整标记对应一个点，知道这一点，就很好处理
If Vars("VectorItemSelected") Is Nothing Then
    MessageBox.Show("请先选择一个形状!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
    Return
End If
If Vars("AdjustMark") Is Nothing Then
    MessageBox.Show("请先选择要删除的点!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
    Return
End If
Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
Dim ItemSelected As VectorItem = Vars("VectorItemSelected") '获得选定的形状
Dim dr As DataRow = ItemSelected.Tag '获得数据行
Dim marks As List(Of VectorPlacemark) = Vars("AdjustMarks") '获取调整标记集合
Dim mark As VectorPlacemark = Vars("AdjustMark") '获取当前调整标记（即将被删除的点）
If dr("类型") = "Line" AndAlso marks.Count = 2 Then
    MessageBox.Show("搞什么啊，线条至少要有两个点！", "提示", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
    Return
End If
If dr("类型") = "Polygon" AndAlso marks.Count = 3 Then
    MessageBox.Show("别犯糊涂，多边形至少要有三个点！", "提示", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
    Return
End If
Dim sb As New StringBuilder()
Dim index As Integer '被删除点的位置
For i As Integer = 0 To marks.Count - 1 '获取被删除点的位置，并重新生成排除删除点后的新经纬度数据
    If marks(i) Is mark Then
        index = i
    Else
        Dim pt As GeoPoint = marks(i).Geometry
        If sb.Length > 0 Then
            sb.Append(",")
        End If
        sb.Append(pt.X & "," & pt.Y)
    End If
Next
marks.Remove(mark) '从集合中移除被删除点
layer.Items.Remove(mark) '从map控件中移除被删除的点
dr("数据") = sb.ToString() '保存数据
Vars("DataRowToDraw") = dr '传递新数据，准备重新绘制生成一个新形状
e.Form.Controls("btnDrawItem").PerformClick() '调用绘制按钮生成并绘制一个新形状
Dim itemNew As VectorItem = Vars("VectorItemDrawn") '获得刚刚生成的新形状
itemNew.Style.Stroke.Color = ItemSelected.style.Stroke.Color '新形状和原形状的边框被背景颜色一致
itemNew.Style.BackColor = ItemSelected.Style.BackColor
layer.Items.Remove(ItemSelected) '移除原形状
Vars("VectorItemSelected") = itemNew '将新形状设置为选中
layer.Items.Remove(itemNew) '确保调整标记始终显示在形状前面
layer.Items.Insert(layer.Items.IndexOf(marks(0)), itemNew)
'选中下一个调整标记作为当前调整标记:
index = Math.Min(index, marks.Count - 1)
mark = marks(index)
mark.Style.BackColor = Color.Blue
mark.Style.Stroke.Color = Color.Blue
Vars("AdjustMark") = mark

19、取消选择(btnUnSelect)按钮代码：

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
If Vars("VectorItemSelected") Is Nothing Then Return
Dim ItemSelected As VectorItem = Vars("VectorItemSelected") '获取之前选择形状
ItemSelected.Style.Stroke.Color = Color.Green '回复默认样式
If TypeOf ItemSelected Is VectorPlacemark Then
    ItemSelected.Style.BackColor = Color.Green
ElseIf TypeOf ItemSelected Is VectorPolygon Then
    ItemSelected.Style.BackColor = Color.FromArgb(38, 0, 255, 0)
End If
Vars("VectorItemSelected") = Nothing '取消选择
Vars("AdjustMark") = Nothing
For Each mark As VectorPlacemark In Vars("AdjustMarks")
    layer.Items.Remove(mark)
Next
Vars("AdjustMarks").Clear()
e.Form.Controls("btnDrawAdjustMarks").PerformClick()

20、删除(btnDelete)按钮代码：

Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
Dim layer As VectorLayer = map.Layers(0)
If Vars("VectorItemSelected") IsNot Nothing Then
    Dim ItemSelected As VectorItem = Vars("VectorItemSelected") '获取选择的形状  
    Dim dr As DataRow = ItemSelected.Tag '获取形状对应的数据行
    dr.Delete() '删除数据行
    e.Form.Controls("btnUnSelect").PerformClick() '模拟取消选择
    layer.Items.Remove(ItemSelected) '移除形状
    Vars("VectorItemSelected") = Nothing
    Vars("StartPoint") = Nothing
End If
e.Form.Controls("btnSelect").PerformClick() '模拟单击选择按钮
e.Cancel = True '已经没必要执行窗口的全局Click事件了

本页地址：http://www.foxtable.com/webhelp/topics/6168.htm