基于内置形状的可视化绘制
本节内容可以参考文件"\CaseStudy\流程图\可视化流程图\基于内置形状的可视化绘制.Table"
这个示例文件也有两个窗口，分别是：
1、"流程图设计"窗口用于以可视化的方式绘制流程图。
2、"流程图显示"窗口用于显示绘制好的流程图。
不同的是，这个示例文件使用的是内置形状，而不是GDI+。
两种方式的区别：
1、GDI+的形状可以设置文字，而内置形状不可以，你只能在形状之上再叠加一个纯文字对象
2、内置形状只有少数几个，参考：GeoMap编程参考
绘制非标形状
3、GDI+提供更灵活，可以绘制任意形状，参考：常用流程符号的绘制
4、内置形状的折线和曲线都可以完美触发事件
5、内置形状起来更简单，更稳定可靠
比较两种方式的流程图显示窗口的代码，你会发现使用内置形状的窗口只在AfterLoad事件中设置了代码，整体要简单很多：
'初始化地图控件，不是必须的，只是使得地图控件更适合作为流程图控件使用:
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( - 159.976654, 49.99558)
'中心点设置在有效区域的左上，因为通常都是往右下绘制，同时也留有一定的余地往左上绘制
'增加矢量层:
Dim
layer
As
New
VectorLayer()
map.Layers.Add(layer)
layer.Style.Font =
New
Font("微软雅黑",
10)
'加载之前绘制好的流程图:
For
Each
dr
As
DataRow
In
DataTables("流程图").Select("",
"顺序")
Select
Case
dr("类型")
Case
"Text"
'绘制文本
Dim
mark
As
VectorPlacemark = map.CreatePlaceMark(dr("位置"))
mark.Marker.Shape = MarkerShape.Custom
mark.Marker.CustomShape = map.CreateTextShape(dr("文本"))
layer.Items.Add(mark)
mark.Tag = dr
If
dr.IsNull("颜色")
=
False
Then
mark.Style.ForeColor = Color.FromArgb(dr("颜色"))
End
If
If
dr.IsNull("背景")
=
False
Then
mark.Style.BackColor = Color.FromArgb(dr("背景"))
End
If
If
dr.IsNull("字体")
=
False
Then
Dim
converter
As
New
FontConverter()
mark.Style.Font = converter.ConvertFromString(dr("字体"))
End
If
Case
"Image"
Dim
mark
As
VectorPlacemark = map.CreatePlaceMark(dr("位置"))
mark.Marker.Shape = MarkerShape.Custom
Dim
img
As
Image = GetImage(dr("文本"))
If
img
Is
Nothing
Then
img = GetImage("Reject.ico")
'如果找不到图片则绘制一个占位图
End
If
mark.Marker.CustomShape = map.CreateImageShape(img)
'对于反复使用的同一个图片，可以考虑将Image存在Var变量或Public变量中
mark.Marker.Size = img.Size'New
Size(48, 48) '默认图片显示大小为48*48，可自行修改，如果要用不同的大小显示各种图片，可以考虑增加一个尺寸列
layer.Items.Add(mark)
mark.Tag = dr
Case
"Line",
"Bezier"
'绘制线条或贝塞尔曲线
Dim
line
As
VectorPolyline
If
dr("类型")
=
"Line"
Then
If
dr("箭头")
= 1
Then
line = map.CreateLineWithArrow(dr("位置"),
True)
'双箭头
ElseIf
dr("箭头")
= -1
Then
line = map.CreateLineWithArrow(dr("位置"))
'单箭头
Else
line = map.CreateLine(dr("位置"))
'无箭头
End
If
Else
If
dr("箭头")
= 1
Then
line = map.CreateBezierCurveArrow(dr("位置"),
True)
'双箭头
ElseIf
dr("箭头")
= -1
Then
line = map.CreateBezierCurveArrow(dr("位置"))
'单箭头
Else
line = map.CreateBezierCurve(dr("位置"))
'无箭头
End
If
End
If
If
dr.IsNull("颜色")
=
False
Then
line.Style.Stroke.Color = Color.FromArgb(dr("颜色"))
Else
line.Style.Stroke.Color = Color.Green
End
If
line.Style.Stroke.Width = 2
If
dr.IsNull("线型")
=
False
Then
line.Style.Stroke.Style = dr("线型")
End
If
layer.Items.Add(line)
line.Tag = dr
Case
Else
Dim
polygon
As
VectorPolygon
Select
Case
dr("类型")
Case
"Diamond"
'绘制菱形
polygon = map.CreateDiamond(dr("位置"))
Case
"Ellipse"
'绘制椭圆
polygon = map.CreateEllipse(dr("位置"))
Case
"Rectangle"
'绘制方形
polygon = map.CreateRectangle(dr("位置"))
Case
"Circle"
'绘制圆形
polygon = map.CreateCircle(dr("位置"),
True)
End
Select
If
polygon
IsNot
Nothing
Then
If
dr.IsNull("颜色")
=
False
Then
polygon.Style.Stroke.Color = Color.FromArgb(dr("颜色"))
Else
polygon.Style.Stroke.Color = Color.Green
End
If
If
dr.IsNull("背景")
=
False
Then
polygon.Style.BackColor = Color.FromArgb(dr("背景"))
End
If
polygon.Style.Stroke.Width = 2
If
dr.IsNull("线型")
=
False
Then
polygon.Style.Stroke.Style = dr("线型")
End
If
layer.Items.Add(polygon)
polygon.Tag = dr
End
If
End
Select
Next
下图是基于内置形状的流程图绘制工具，可以看到除了少些形状，其他看起来都是一样的：