MapObject学习笔记－第五讲 MO图形的绘制
第五讲 MO图形的绘制
MO虽然不是绘图软件，但经常要用到在地图上画点标明位置，画矩形或多边形标明地图查询范围等操作，因此也需要用到一些基本的绘图功能。
MO的绘图就是在MAP上产生图形对象的过程，图形对象主要有：Point（点），Points（点集）、Line（线）、Rectangle（矩形）、Polygon（多边形）、Ellipse（椭圆）。
绘图时，先要创建一个绘图对象，给他赋值（位置和尺寸），再在Symbol对象中定义显示方式，最后用Drawshape方法在地图上显示这个图形。
定义Symbol对象，不仅可以设置线型、填充方式、尺寸、颜色和字体等，还可以画出多种预定义的符号。Drawshape方法绘图外，还可以用AddEvent方法在动态图层上画动态图形对象（GeoEvent）。另外还可以用DrawText方法在地图上写字。
一、DrawShape绘图方法
1、DrawShape定义
DrawShape方法的语法为：
object.DrawShape shape, symbol
其中，object：为绘图目的对象，一般为Map对象；
shape：为绘图内容，是图形对象（Point, Points, Line, Rectangle, Polygon or Ellipse）或记录集（Recordset）对象；
symbol：是一个Symbol对象，说明绘图方式。
注意：调用DrawShape必须在LAYER或TrackingLayer的drawing事件中，即AfterTrackingLayerDraw，BeforeLayerDraw，BeforeTrackingLayerDraw，AfterLayerDraw事件过程中才有效。
如果指定一个Recordset作为DrawShape的参数，该数据集必须是从GeoDataset获取，而不是从一个Table对象获取，同时MO从shape字段的第一个特征值开始，到最后一个结束，然后又指向第一个记录。
2、画点
（1）预定义画点：可以用Point对象画一个点，也可以用Points对象画多个点。示例：
Dim sym As New MapObjects2.Symbol
Dim p As Point
Dim pts As Points
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Set pts = New Points
Set p = Map1.ToMapPoint(1000, 1000)
pts.Add p'是Points对象中的一个函数，功能是增加一个Point成员到Points对象内。
Set p = Map1.ToMapPoint(3000, 2000)
pts.Add p
sym.Color = moRed
sym.SymbolType = moPointSymbol
sym.Size = 3
Map1.DrawShape pts, sym
End Sub
（2）利用鼠标点击画点：通过鼠标点击屏幕获取点的坐标，进行画点操作。示例：
Dim sym As New MapObjects2.Symbol
Dim p As Point
Dim pts As New Points
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If Not pts Is Nothing Then
sym.Color = moRed
sym.SymbolType = moPointSymbol
sym.Size = 3
Map1.DrawShape pts, sym
Map1.DrawShape pts, sym
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Set p = Map1.ToMapPoint(X, Y)
pts.Add p
Map1.TrackingLayer.Refresh True’ TrackingLayer对象是MAP控件中的一个图层，它描述位置可以动态改变的地理目标，Refresh是TrackingLayer对象的成员函数，强制刷新TrackingLayer对象。
End Sub
3、画线
MO中画线的基本原理是先设置两个点，将他们添加到一个Points对象中，再将Points对象放到一个Line对象中，使用DrawShape方法就可以画出一条线段来。如果在Points对象中有N个点，则可以产生一条N-1段的折线。
（1）预定义点画线，示例：
Dim g_line As MapObjects2.Line
Dim pts As Points
Dim p As Point
Dim sym As Symbol
Private Sub Command1_Click()
Set g_line = New MapObjects2.Line
Set pts = New Points
Set p = Map1.ToMapPoint(1000, 1000)
pts.Add p
Set p = Map1.ToMapPoint(2000, 3000)
pts.Add p
g_line.Parts.Add pts 'Parts是Line对象的一个属性，此属性指向一个Parts集合对象，通过Parts属性可以检索组成线的片断（Parts），而Parts的每一个成员是一个点集（Points）。
Set pts = g_line.Parts(0)
Map1.Refresh
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If Not g_line Is Nothing Then
Dim sym As New Symbol
If pts.Count > 1 Then’ Count属性表示当前Points对象内成员的数目，这是一个只读值。
sym.Color = moRed
sym.SymbolType = moLineSymbol
sym.Size = 5
Map1.DrawShape g_line, sym
End If
End If
End Sub
（2）鼠标点击获取点并画线，示例：
Dim g_line As MapObjects2.Line
Dim pts As Points
Dim p As Point
Dim sym As Symbol
Private Sub Command1_Click()’设置清空按钮
Set g_line = Nothing
Set pts = Nothing
Map1.Refresh
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim sym As New Symbol
If Not g_line Is Nothing Then
sym.Color = moBlack
Map1.DrawShape pts, sym
If pts.Count > 1 Then
sym.Color = moRed
sym.SymbolType = moLineSymbol
sym.Size = 5
Map1.DrawShape g_line, sym
End If
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If g_line Is Nothing Then
Set g_line = New MapObjects2.Line
End If
If pts Is Nothing Then
Set pts = New Points
End If
Set p = Map1.ToMapPoint(X, Y)
pts.Add p
If pts.Count = 1 Then
g_line.Parts.Add pts
Set pts = g_line.Parts(0)
End If
Map1.TrackingLayer.Refresh True
Else
MsgBox "right"
End If
End Sub
4、画矩形和椭圆
（1）预定义画矩形：画矩形是先定义一个矩形对象，给它的top、left、bottom、right属性赋值，再使用DrawShape方法就可以画出一个矩形来。定义矩形范围时，可以先确定一个中心点，再确定一个半径（或X方向半径和Y方向半径），得到top、left、bottom、right的值。示例：
Option Explicit
Dim rect As MapObjects2.Rectangle
Private Sub Command1_Click()
Dim dist As Double
Dim pt As New Point
Set rect = New MapObjects2.Rectangle
dist = 0.2
Set pt = Map1.ToMapPoint(2500, 1500)’这里可以动态设置中心点的位置
rect.Right = pt.X + dist
rect.Left = pt.X - dist
rect.Top = pt.Y + dist
rect.Bottom = pt.Y - dist
Map1.Refresh
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If Not rect Is Nothing Then
Dim sym As New Symbol
sym.SymbolType = moFillSymbol
sym.Style = moDiagonalCrossFill
sym.Color = moBlue
Map1.DrawShape rect, sym
End If
End Sub
（2）定义一个矩形框对象后，进行画矩形。示例：
Option Explicit
Dim rect As MapObjects2.Rectangle
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim sym As New MapObjects2.Symbol
If Not rect Is Nothing Then
sym.SymbolType = moFillSymbol
sym.Style = moDiagonalCrossFill
sym.Color = moBlue
Map1.DrawShape rect, sym
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Set rect = Map1.TrackRectangle
Map1.TrackingLayer.Refresh True
End Sub
用同样的方法可以画出椭圆来。
5、用Track方法画图形
在MO中还可以用一类方法在地图上半自动画图，如：TrackCircle方法，点击产生圆心，拖动产生半径，放手成圆形；TrackRectangle方法，点击产生一个角，拖动放大，放手形成矩形；TrackPolygon方法，点击画几条直线，双击形成多边形图形。这一类方法都是以Track开头，所以称为Track画图方法，这和TrackingLayer（动态图层）毫无关系。示例：
Option Explicit
Dim eli As MapObjects2.Ellipse
Dim recs As MapObjects2.Rectangle
Dim ply As MapObjects2.Polygon
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim sym As New MapObjects2.Symbol
sym.SymbolType = moFillSymbol
sym.Style = moDiagonalCrossFill
If Not recs Is Nothing Then
sym.Color = moBlue
Map1.DrawShape recs, sym
End If
If Not eli Is Nothing Then
sym.Color = moRed
Map1.DrawShape eli, sym
End If
If Not ply Is Nothing Then
sym.Color = moGreen
Map1.DrawShape ply, sym
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Option1 Then
Set recs = Map1.TrackRectangle
ElseIf Option2 Then
Set eli = Map1.TrackCircle
Else
Set ply = Map1.TrackPolygon
End If
Map1.TrackingLayer.Refresh True
End Sub
二、写文字
MO一般采用DrawText方法在地图上写文字，也可以用画点时的motruetypemarker方式，在地图上写各种地图上常用的符号。
1、DrawText方法
用DrawText方法可以在地图上写文字，语法结构为：
object.DrawText text, shape, symbol
其中，object：对象，text：字符串，shape：参照图形，可以是点、点集、线和矩形；symbol：为一个Textsymbol显示对象。如果参照图形为点，则文字中心在点上；如果为点集，则中心在点集的范围中心上；为直线，中心在线段的中心上，方向同线段的方向；为折线，则文字的中心和方向按照点集的样条插值计算；如果为矩形，则文字国矩形中心的水平线排列。
（1）在点击出写文字
示例：Option Explicit
Dim p As MapObjects2.Point
Dim tSym As New TextSymbol
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If Not p Is Nothing Then
Dim sym As New Symbol
tSym.Color = moRed
Map1.DrawText Text1.Text, p, tSym
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set p = Map1.ToMapPoint(x, y)
Map1.TrackingLayer.Refresh True
End Sub
（2）在线段上添加文字
示例：Option Explicit
Dim g_line As MapObjects2.Line
Dim pts As MapObjects2.Points
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
' make sure there's a line
If Not g_line Is Nothing Then
' make sure there's at least two points in the line
If pts.Count > 1 Then
Dim tSym As New TextSymbol
' use the font of the textbox control
Set tSym.Font = Text1.Font
Dim sym As New Symbol
sym.Color = moRed
Map1.DrawShape g_line, sym
Map1.DrawText Text1.Text, g_line, tSym
End If
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
' create the line if it does not exist
If g_line Is Nothing Then
Set g_line = New MapObjects2.Line
End If
If pts Is Nothing Then
Set pts = New MapObjects2.Points
End If
' create a point and add it to the line
Dim p As Point
Set p = Map1.ToMapPoint(x, y)
pts.Add p
If pts.Count = 1 Then
g_line.Parts.Add pts
Set pts = g_line.Parts(0)
End If
' refresh the trackingLayer
Map1.TrackingLayer.Refresh True
Else
Dim r As MapObjects2.Rectangle
Set r = Map1.TrackRectangle
If Not r Is Nothing Then Map1.Extent = r
End If
End Sub
三、Symbol
Symbol是控制地图上的特征或图形的显示方式的对象或属性，图上的特征都是通过设置图层的Symbol属性来实现的，如：layer.Symbol.Color = moRed，如果没有设置图层的Symbol属性，MO就会使用缺省的线型、填充方式、尺寸、字体和随机的颜色。
在设置图形的显示方式时，要定义一个Symbol对象：
Dim sym As New Symbol
再设置SymbolType属性，这说明显示对象是点、线还是面，使用的常量如下：
Constant Value Description
moPointSymbol 0 symbol for a Point or Points object
moLineSymbol 1 symbol for a Line object
moFillSymbol 2 symbols for a Polygon, Rectangle or Ellipse object
例如：sym.SymbolType = moFillSymbol
然后就可以设置Symbol的style属性，对于点来设置点的形状和预定义的符号，对于线对象来设置线型，对于面对象来设置填充方式。
最后来设置size、color、font等。
使用预定义符号：
在画点时，设置Symbol的style属性为moTrueTypeMarker 方式，可以在地图上写各种地图上常用的符号，先设置：sym.Style = moTrueTypeMarker，然后再设置sym.CharacterIndex = 35。CharacterIndex的序号是从33开始的。下面就是一个使用预定义字符的例子：
Option Explicit
Dim Pt(400) As MapObjects2.Point
Dim Pt1(400) As MapObjects2.Point
Dim Sym(400) As New MapObjects2.Symbol
Dim tSym As New MapObjects2.TextSymbol
Private Sub Form_Load()
Dim i As Integer
Dim Swidth As Integer
Dim Sheight As Integer
' Swidth = Screen.Width
' Sheight = Screen.Height
Swidth = 800 * 15
Sheight = 600 * 15
Me.Height = Sheight - 100
Me.Width = Swidth - 300
Map1.Height = Me.Height - 200
Map1.Width = Me.Width - 200
Map1.Top = 100
Map1.Left = 100
For i = 0 To 399
With Sym(i)
.Style = moTrueTypeMarker
.SymbolType = moPointSymbol
'.Font = "ESRI Transportation & Municipal"
.Size = 20
.Style = moTrueTypeMarker
.Color = moBlack
End With
Next i
tSym.Color = moBlack
tSym.Font.Size = 10
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim i As Integer
For i = 0 To 399
If Not Pt(i) Is Nothing Then
Map1.DrawShape Pt(i), Sym(i)
Map1.DrawText 33 + i, Pt1(i), tSym
End If
Next i
End Sub
Private Sub Map1_Click()
Dim i As Integer, j As Integer, k As Integer
Const Mx0 = 400
Const My0 = 300
Const Mxc = 520
Const Myc = 800
k = 0
j = 0
For i = 0 To 199
'For i = 200 To 399
Set Pt(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + k * Myc)
Set Pt1(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + 400 + k * Myc)
Sym(i).CharacterIndex = 33 + i
j = j + 1
If j >= 20 Then
j = 0
k = k + 1
End If
Next i
Map1.TrackingLayer.Refresh True
End Sub
画出交通和市政的预定义符号，符号代码如下：
Option Explicit
Dim Pt(400) As MapObjects2.Point
Dim Pt1(400) As MapObjects2.Point
Dim Sym(400) As New MapObjects2.Symbol
Dim tSym As New MapObjects2.TextSymbol
Private Sub Form_Load()
Dim i As Integer
Dim Swidth As Integer
Dim Sheight As Integer
Dim fnt As New StdFont
fnt.Name = "Wingdings"
' Swidth = Screen.Width
' Sheight = Screen.Height
Swidth = 800 * 15
Sheight = 600 * 15
Me.Height = Sheight - 100
Me.Width = Swidth - 300
Map1.Height = Me.Height - 200
Map1.Width = Me.Width - 200
Map1.Top = 100
Map1.Left = 100
For i = 0 To 399
With Sym(i)
.Style = moTrueTypeMarker
.SymbolType = moPointSymbol
'.Font = "ESRI Transportation & Municipal"
.Font = fnt
.Size = 20
.Style = moTrueTypeMarker
.Color = moBlack
End With
Next i
tSym.Color = moBlack
tSym.Font.Size = 10
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim i As Integer
For i = 0 To 399
If Not Pt(i) Is Nothing Then
Map1.DrawShape Pt(i), Sym(i)
Map1.DrawText 33 + i, Pt1(i), tSym
End If
Next i
End Sub
Private Sub Map1_Click()
Dim i As Integer, j As Integer, k As Integer
Const Mx0 = 400
Const My0 = 300
Const Mxc = 520
Const Myc = 800
k = 0
j = 0
For i = 0 To 199
'For i = 200 To 399
Set Pt(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + k * Myc)
Set Pt1(i) = Map1.ToMapPoint(j * Mxc + Mx0, My0 + 400 + k * Myc)
Sym(i).CharacterIndex = 33 + i
j = j + 1
If j >= 20 Then
j = 0
k = k + 1
End If
Next i
Map1.TrackingLayer.Refresh True
End Sub
