⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 drawsymbol.cls

📁 这个是grs源程序,mo在图象显示上很好,所以大家一定要下载
💻 CLS
字号:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDrawSymbol"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim curMap As Object
Dim cursymbol As MapObjects2.symbol
Public Property Get symbol()

End Property

Public Property Set symbol(symbol As MapObjects2.symbol)
  'This procedure sets the symbol and draws it to to the map control.
  Set cursymbol = symbol
End Property

Public Property Get mapControl()

End Property

Public Property Set mapControl(curControl As Control)
  Set curMap = curControl
End Property

Public Sub Draw()
  'This procedure draws the settings of the current symbol onto
  'the map control on the form. A single instance of the symbol
  'is drawn in the center of the map.

  'These geometric objects are used for drawing symbols
  Dim drawLine As New MapObjects2.Line
  Dim drawPoint As New MapObjects2.Point
  Dim drawPoints As New MapObjects2.Points
  Dim drawRect As New MapObjects2.Rectangle

  'Since the map control has no layers, coordinates are set by
  'pixel values. Calculate pixels for map control...

  Dim mapHeight As Integer, mapWidth As Integer
  mapHeight = curMap.Height / 15
  mapWidth = curMap.Width / 15

  Select Case frmLayerProp.curFeatureType

  Case moPoint
    'Just make a point and draw it
    drawPoint.x = mapWidth / 2
    drawPoint.y = mapHeight / 2
    curMap.DrawShape drawPoint, cursymbol

  Case moLine
    'Add the end points to the points collection

    drawPoint.x = 0
    drawPoint.y = mapHeight / 2
    drawPoints.Add drawPoint
    drawPoint.x = mapWidth
    drawPoint.y = mapHeight / 2
    drawPoints.Add drawPoint
    drawLine.Parts.Add drawPoints
    curMap.DrawShape drawLine, cursymbol
    
  Case moPolygon
    'Size the rectangle to be a little smaller than the map.
    Dim margin As Integer
    margin = 3
    drawRect.Top = margin
    drawRect.Left = margin
    drawRect.Bottom = mapHeight - margin
    drawRect.Right = mapWidth - margin
    curMap.DrawShape drawRect, cursymbol
  End Select
  
End Sub

Public Sub GetBitMap()
  frmClipboard.MapToBitmap curMap
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -