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