clscustomsimplerend.cls

FloodEvaluation-程序是gis方面的程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCustomSimpleRend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'                CustomSimpleRenderer
'           +++ Version 1.0  1/11/2000 +++
'           --  Last edit:   12/2/2000 --

' Sample application to demonstrate creation of a custom simple renderer.  The renderer
'   supports the TOC and can be used to render any feature type.

Option Explicit

' a custom renderer must implement the following two interfaces
Implements IFeatureRenderer
Implements IPersistVariant
' implementing ILegendInfo adds Table of Contents (TOC) functionality
Implements ILegendInfo
' implementing ISimpleRenderer allows one to set the symbol for the renderer
'   before assigning it to a layer.  this also makes the single symbol property
'   page useful for editing the renderer properties
Implements ISimpleRenderer

Private m_LegendGroup As ILegendGroup

Private Sub Class_Initialize()
On Error GoTo ErrHand
  
  ' renderer will have one legend group, with one legend class within this group.
  ' draw symbol will be stored and accessed from this legendclass
  
  ' setup m_LegendGroup
  Set m_LegendGroup = New LegendGroup
  Dim pLegendClass As ILegendClass
  Set pLegendClass = New LegendClass

  ' add a legend class to m_LegendGroup
  m_LegendGroup.AddClass pLegendClass
  m_LegendGroup.Visible = True
  m_LegendGroup.Editable = True
 
  GoTo EndProc
  
ErrHand:
    MsgBox "Class Initialize" & ERR.Description
EndProc:
    ' good practice to manually set all pointers to Nothing
    Set pLegendClass = Nothing
    Exit Sub
End Sub

Private Sub Class_Terminate()
    Set m_LegendGroup = Nothing
End Sub

Private Function IFeatureRenderer_CanRender(ByVal featClass As esriCore.IFeatureClass, ByVal Display As esriCore.IDisplay) As Boolean
' returns true as long as the feature type is not null
On Error GoTo ErrHand

    If Not featClass.shapeType = esriGeometryNull Then
        IFeatureRenderer_CanRender = True
    Else
        IFeatureRenderer_CanRender = False
    End If
    
    GoTo EndProc
ErrHand:
    MsgBox "CanRender" & ERR.Description
EndProc:
    Exit Function
End Function

Private Sub IFeatureRenderer_Draw(ByVal Cursor As esriCore.IFeatureCursor, _
                                  ByVal drawPhase As esriCore.esriDrawPhase, _
                                  ByVal Display As esriCore.IDisplay, _
                                  ByVal trackCancel As esriCore.ITrackCancel)
On Error GoTo ErrHand
 
  ' do not draw features if no display or wrong drawphase
  If (Display Is Nothing) Or (Not drawPhase = esriDPGeography) Then
    GoTo EndProc
  End If
  
  ' the draw symbol comes from m_LegendGroup
  Dim pSym As ISymbol
  Set pSym = m_LegendGroup.Class(0).Symbol
  ' do not draw features if symbol hasn't been set
  If pSym Is Nothing Then
    GoTo EndProc
  End If
  
  ' loop through the features and draw them using the symbol
  Dim pf As IFeature
  Set pf = Cursor.NextFeature
  Do While Not pf Is Nothing
    Dim pFD As IFeatureDraw
    Set pFD = pf
    pFD.Draw drawPhase, Display, pSym, False, Nothing, esriDSNormal
    Set pf = Cursor.NextFeature
  Loop

    GoTo EndProc
ErrHand:
    MsgBox "Draw" & ERR.Description
EndProc:
    Set pSym = Nothing
    Set pf = Nothing
    Set pFD = Nothing
    Exit Sub
End Sub

Private Sub IFeatureRenderer_PrepareFilter(ByVal pFeatClass As esriCore.IFeatureClass, ByVal QueryFilter As esriCore.IQueryFilter)

End Sub

Private Property Set IFeatureRenderer_ExclusionSet(ByVal pIDSet As esriCore.IFeatureIDSet)
    ' exclusion not implemented for this renderer
End Property

Private Property Get IFeatureRenderer_RenderPhase(ByVal drawPhase As esriCore.esriDrawPhase) As Boolean
' renderer only uses the esriDPGeography drawphase
On Error GoTo ErrHand

    If drawPhase = esriDPGeography Then
        IFeatureRenderer_RenderPhase = True
    Else
        IFeatureRenderer_RenderPhase = False
    End If
 
Exit Property
ErrHand:
  MsgBox "Get RenderPhase" & ERR.Description
End Property

Private Property Get IFeatureRenderer_SymbolByFeature(ByVal Feature As esriCore.IFeature) _
As esriCore.ISymbol
On Error GoTo ErrHand
    
    Dim pSym As ISymbol
    Set pSym = m_LegendGroup.Class(0).Symbol
    Set IFeatureRenderer_SymbolByFeature = pSym

    GoTo EndProc
ErrHand:
    MsgBox ERR.Description
EndProc:
    Set pSym = Nothing
    Exit Property
End Property

Private Property Get ILegendInfo_LegendGroup(ByVal Index As Long) As esriCore.ILegendGroup
' returns legend group if a symbol has been set
    
    If Not m_LegendGroup.Class(0).Symbol Is Nothing Then
        Set ILegendInfo_LegendGroup = m_LegendGroup
    Else
        Set ILegendInfo_LegendGroup = Nothing
    End If
End Property

Private Property Get ILegendInfo_LegendGroupCount() As Long
' returns 1 if m_LegendGroup exists and symbol has been set
On Error GoTo ErrHand
    
    If (Not m_LegendGroup Is Nothing) And (Not m_LegendGroup.Class(0).Symbol Is Nothing) Then
        ILegendInfo_LegendGroupCount = 1
    Else
        ILegendInfo_LegendGroupCount = 0
    End If
    
    Exit Property
ErrHand:
  MsgBox "Get LegendGroupCount" & ERR.Description
End Property

Private Property Get ILegendInfo_LegendItem() As esriCore.ILegendItem
    
    Set ILegendInfo_LegendItem = Nothing
End Property

Private Property Let ILegendInfo_SymbolsAreGraduated(ByVal AreGrad As Boolean)

End Property

Private Property Get ILegendInfo_SymbolsAreGraduated() As Boolean
' this renderer does not have graduated symbols
    
    ILegendInfo_SymbolsAreGraduated = False
End Property

Private Property Get IPersistVariant_ID() As esriCore.IUID
' returns the ProgID for the renderer
On Error GoTo ErrHand:
    
    Dim id As New UID
    id = "CustomSimpleRenderer.CustomSimpleRend"
    Set IPersistVariant_ID = id
    
    GoTo EndProc
ErrHand:
    MsgBox ERR.Description
EndProc:
    Set id = Nothing
    Exit Property
End Property

Private Sub IPersistVariant_Load(ByVal stream As esriCore.IVariantStream)
' load the persisted parameters of the renderer
    
    Set m_LegendGroup = stream.Read
End Sub

Private Sub IPersistVariant_Save(ByVal stream As esriCore.IVariantStream)
' persist the settings for the renderer
    
    stream.Write m_LegendGroup
End Sub

Private Property Get ISimpleRenderer_Description() As String
    
    ISimpleRenderer_Description = m_LegendGroup.Class(0).Description
End Property

Private Property Let ISimpleRenderer_Description(ByVal strInDescrip As String)
    
    m_LegendGroup.Class(0).Description = strInDescrip
End Property

Private Property Get ISimpleRenderer_Label() As String
    
    ISimpleRenderer_Label = m_LegendGroup.Class(0).Label
End Property

Private Property Let ISimpleRenderer_Label(ByVal strInLabel As String)
    
    m_LegendGroup.Class(0).Label = strInLabel
End Property

Private Property Set ISimpleRenderer_Symbol(ByVal pInSymbol As esriCore.ISymbol)
    
    Set m_LegendGroup.Class(0).Symbol = pInSymbol
End Property

Private Property Get ISimpleRenderer_Symbol() As esriCore.ISymbol
    
    Set ISimpleRenderer_Symbol = m_LegendGroup.Class(0).Symbol
End Property