jxfzcgh
外卖仔
外卖仔
  • 注册日期2003-07-26
  • 发帖数69
  • QQ
  • 铜币452枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:3626回复:5

在mo中用位图标注point对象!!

楼主#
更多 发布于:2003-07-26 22:14
先定义一个类模块(MyCustomSymbol,确定引用AFCustom对象)
Implements AFCustom.ICustomMarker
Private m_filename As String
Private m_dpi As Double
Private m_picture As IPicture
Public Sub SetFileName(fn As String)
    m_filename = fn
End Sub
Private Sub ICustomMarker_Draw(ByVal hDC As Long, ByVal x As Long, ByVal y As Long)
    Dim pixWidth As Double, pixHeight As Double
    pixWidth = m_picture.Width * m_dpi / 2540
    pixHeight = m_picture.Height * m_dpi / 2540
    
    If Not m_picture Is Nothing Then

        m_picture.Render hDC, x - pixWidth / 2, y + pixWidth / 2, pixWidth, -pixHeight, _
        0, 0, m_picture.Width, m_picture.Height, Null
    End If
End Sub
Private Sub ICustomMarker_ResetDC(ByVal hDC As Long)
    Set m_picture = Nothing
End Sub
Private Sub ICustomMarker_SetupDC(ByVal hDC As Long, ByVal dpi As Double, ByVal pBaseSym As Object)
    m_dpi = dpi
    Set m_picture = LoadPicture(m_filename)
End Sub

然后在窗体里面可以使用这个类模块:
Private Sub Form_Load()
  
  Dim bmpSym As New MyCustomSymbol
  Dim lyr As New MapLayer
  Set lyr = Map1.Layers(0)
 
  bmpSym.SetFileName "C:\Documents and Settings\cgh\My Documents\My Pictures\1.bmp"
  Debug.Print Map1.Layers(0).shapeType
  If Map1.Layers(0).shapeType = 21 Then
      Set lyr.Symbol.Custom = bmpSym
  End If
End Sub


喜欢0 评分0
游客

返回顶部