VB＋Mapobject2.0自定义地图图标

 

MapObjects2 allows you to write your own symbol rendering code in an integrated manner. To do so, you write an OLE (COM) class that implements a well defined API.   MapObjects2 now supports five custom interfaces:

ICustomFill

ICustomLine

ICustomMarker

ICustomProjection

ICustomRenderer

Since MapObjects2 uses OLE interfaces to interact with custom symbols, you do not need any source code or libraries to build your custom symbols. All the definitions you need are distributed in a type library (AfCust20.tlb). This file can be found in the “../Common Files/ESRI/” directory.

1.新建类模块(AFCustom.cls)

2.工程引用——》浏览AfCust20.tlb——》添加AFCutom引用

3.类模块name为CustomSymbol

4.编写如下代码，文件——>生成AFCustomSymbol.dll

Option Explicit

'Indicate that this class will implement ICustomMarker
'Remember that you must first browse for the type library
Implements AFCustom.ICustomMarker

'Internal data members
Private m_filename As String
Private m_dpi As Double
Private m_picture As IPicture

'External method which allows users to specify the
'image path and name to be rendered.
Public Sub SetFileName(fn As String)
m_filename = fn
End Sub

'The draw method. This method is called for each symbol.

Private Sub ICustomMarker_Draw(ByVal hDC As Long, ByVal x As Long, ByVal y As Long)
Dim pixWidth As Double, pixHeight As Double

'Convert the picture width (normally in HI_METRIC) to pixels
'using the previously stored dpi member.
pixWidth = m_picture.Width * m_dpi / 2540
pixHeight = m_picture.Height * m_dpi / 2540

'Always check for a valid interface before using it.
If Not m_picture Is Nothing Then
'Render the picture, centered on the given point.

m_picture.Render hDC, x - pixHeight / 2, y + pixWidth / 2, pixWidth, -pixHeight, 0, 0, m_picture.Width, m_picture.Height, Null
End If

End Sub

'This method is called once per refresh, at the completion of rendering.
Private Sub ICustomMarker_ResetDC(ByVal hDC As Long)
'Set the picture object to nothing, free all resources.
Set m_picture = Nothing
End Sub

'This method is called once per refresh, prior to rendering.
Private Sub ICustomMarker_SetupDC(ByVal hDC As Long, ByVal dpi As Double, ByVal pBaseSym As Object)

'Store the dots per inch.
m_dpi = dpi

'Try to load the specified picture.
Set m_picture = LoadPicture(m_filename)
End Sub

5.新建工程调用自定义AFCustomSymbol.dll

<1> 工程引用AFCustomSymbol.dll

<2>简单引用

　　Private Sub Form_Load()
Dim bmpSym As New AFCustomSymbol.CustomSymbol
bmpSym.SetFileName App.Path & "/image/1.BMP"
Set Map1.Layers(0).Symbol.Custom = bmpSym
End Sub

<3>分类使用

Dim Map_ValueMapRenderer As New MapObjects2.ValueMapRenderer
Private Sub CmdType_Click()
    Call Classify_Type("type_name")
End Sub

Private Sub CmdZoomAll_Click()
    Map1.Extent = Map1.FullExtent
End Sub

Private Sub Form_Load()
Dim bmpSym As New AFCustomSymbol.CustomSymbol
bmpSym.SetFileName App.Path & "/image/1.BMP"
Set Map1.Layers(0).Symbol.Custom = bmpSym
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Map1.Extent = Map1.TrackRectangle
End Sub

Sub Classify_Type(strfield As String)
            Dim strsUniqueValues As New MapObjects2.Strings
            Dim Map_RecordSet As MapObjects2.Recordset
           
            Dim Map_Symbol_N As Integer
            Dim n As Integer
            Set Map_RecordSet = Map1.Layers(0).Records
            Set stats = Map_RecordSet.CalculateStatistics(strfield)

            Map_RecordSet.MoveFirst
                Do While Not Map_RecordSet.EOF
                strsUniqueValues.Add Map_RecordSet(strfield).Value
                Map_RecordSet.MoveNext
                Loop
'
            n = strsUniqueValues.Count
'                If n > Map_Symbol_Max Then
'                n = Map_Symbol_Max
'                End If

            Map_ValueMapRenderer.Field = strfield
            Map_ValueMapRenderer.ValueCount = n
            Map_Symbol_N = n

               
                For i = 0 To Map_Symbol_N - 1
                    Map_ValueMapRenderer.Value(i) = strsUniqueValues(i)
                Next i
                   
            Dim symInt As Integer

            If Map1.Layers(0).shapeType = moShapeTypeMultipoint Then
            symInt = 0
            Else
            symInt = Map1.Layers(0).shapeType - 21
            End If
            Map_ValueMapRenderer.SymbolType = symInt
            Dim bmpSym(0 To 3) As New AFCustomSymbol.CustomSymbol
                Dim j As Integer
                j = 0
                For i = 0 To Map_ValueMapRenderer.ValueCount - 1
           
'            Dim MySymbol As New MapObjects2.Symbol
'            MySymbol.Color = RGB(255, 0, 0)
'            MySymbol.Size = 10
'            MySymbol.Style = 1
'
     
                Dim Str_Sym_File As String
     
                    Str_Sym_File = App.Path & "/image/" & j + 1 & ".bmp"
                    If j > 3 Then j = 0
                    bmpSym(j).SetFileName Str_Sym_File
                    Map_ValueMapRenderer.Symbol(i).Custom = bmpSym(j)
                    j = j + 1

'            Map_ValueMapRenderer.Symbol(i).Color = MySymbol.Color
'            Map_ValueMapRenderer.Symbol(i).Font = MySymbol.Font
'            Map_ValueMapRenderer.Symbol(i).Size = MySymbol.Size
'            Map_ValueMapRenderer.Symbol(i).Style = i
            Next i

            Set Map1.Layers(0).Renderer = Map_ValueMapRenderer
'
'                For i = 1 To Map_ValueMapRenderer.ValueCount - 1
'                    Map_Symbol(i) = Map_ValueMapRenderer.Symbol(i)
'
'                Next i
        Map1.Refresh
End Sub