合并文本和形状

本节内容可以参考文件"\CaseStudy\流程图\纯代码流程图\纯代码绘制之三.Table"

文本通常是显示在形状之上的，所以将草图转换为数据表内容时，可以忽略文本对象，直接将文本内容填入到所属形状的文本列。

这是新的草图，已经去掉了文本对象的坐标：

现在数据表内容变得更为简洁:

绘制代码如下，要比之前的代码稍微复杂点(因为定位箭头的文本位置比较麻烦)，另外这里说的合并文本和形状，仅止于数据表，是假合并，文本和形状依然是独立的，真正的合并下一节再介绍:

'初始化地图控件，不是必须的，只是使得地图控件更适合作为流程图控件使用:
Dim map As GeoMap = e.Form.Controls("Map1").GeoMap
map.UseGallPetersProjection = True '采用Gall Peters投影方式
map.Viewport.Limits.MaxLat = 60 '排除高纬度地区，因为高纬度地区变形大
map.Viewport.Limits.MinLat = -60
map.Zoom = 12 '缩放指数设置为12，留足够的区间用于放大和缩小
map.CenterTo( - 160, 50) '中心点设置在有效区域的左上，因为通常都是往右下绘制，同时也留有一定的余地往左上绘制
'增加矢量层:
Dim layer As New VectorLayer()
map.Layers.Add(layer)
layer.Style.Stroke.Width = 2
layer.Style.Font = New Font("微软雅黑", 12)
'用代码绘制流程图，注意以下定位均采用像素，在绘制时候要转为经纬度，
Dim xStart As Integer = 50 '本流程图整体是从左到右，所以起点在左中位置
Dim yStart As Integer = 200
Dim xStep As Integer = 96 '默认形状宽度，也是箭头的默认长度
Dim yStep As Integer = 64 '默认形状高度，宽高比大概是3:2, 96*2/3 = 64
For Each dr As DataRow In DataTables("流程图").DataRows '绘制流程图
    Dim gps As New List(Of GeoPoint)
    Dim pts() As String = dr("位置").Split(",")
    For idx As Integer = 0 To pts.Length - 1 Step 2
        Dim dx As Integer = xStart + Val(pts(idx)) * xStep
        Dim dy As Integer = yStart + Val(pts(idx + 1)) * yStep
        Dim p As New Point(dx, dy)
        gps.Add(map.ToGeoPoint(p))
    Next
    Dim item As VectorItem = Nothing
    '先绘制形状
    Select Case dr("类型")
        Case "四边形"
            item = map.CreateRectangle(gps(0), gps(1))
        Case "菱形"
            item = map.CreateDiamond(gps(0), gps(1))
        Case "箭头"
            item = map.CreateLineWithArrow(gps)
    End Select
    If item IsNot Nothing Then
        item.Tag = dr '将tag设置为对应的数据行，用于响应事件
        layer.Items.Add(item)
    End If
    '再绘制文本
    If dr.IsNull("文本") = False Then
        Dim txt As New VectorPlacemark()
        txt.Marker.Shape = MarkerShape.Custom
        txt.Marker.CustomShape = map.CreateTextShape(dr("文本"))
        If dr("类型") = "文本" Then '如果类型为文本，也就是独立的文本，不属于任何形状的文本，这个例子其实没有
            txt.Geometry = gps(0)
        ElseIf item IsNot Nothing Then '如果是其他形状，且已经成功生成形状
            If dr("类型") = "箭头" Then'箭头可能是折线，取线条第一段的中心作为文本位置
                Dim dx1 As Integer = xStart + Val(pts(0)) * xStep
                Dim dy1 As Integer = yStart + Val(pts(1)) * yStep
                Dim dx2 As Integer = xStart + Val(pts(2)) * xStep
                Dim dy2 As Integer = yStart + Val(pts(3)) * yStep
                Dim dx As Integer = dx1 + (dx2 - dx1) / 3 '文本位置不完全在线段中心，而是偏向起点
                Dim dy As Integer = dy1 + (dy2 - dy1) / 3
                If dx1 = dx2 Then
                    dx = dx + 15 '如果是垂直线，则文本显示在线条右侧
                Else
                    dy = dy - 15 '如果是水平线，则文本显示在线条上侧
                End If
                Dim p As New Point(dx, dy)
                txt.Geometry = map.ToGeoPoint(p)
            Else '如果是其他形状(通常是四边形或菱形)，取形状中心作为文本文职
                Dim cp = item.Geometry.Center '获取形状的中心位置坐标，注意用法!!!!
                txt.Geometry = New GeoPoint(cp.X, cp.Y) '将文本位置设置为形状的中心
            End If
        End If
        If txt IsNot Nothing Then
            txt.Tag = dr
            layer.Items.Add(txt)
        End If
    End If
Next