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