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

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 = #ff0000
' 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

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/swfcsunboy/archive/2008/02/15/2096820.aspx