clslayerlabels.cls

gis地图 --- --- --文字1

          End If  'pFeature.shape is nothing
          
          Set pFeature = pInCursor.NextFeature
          
        Loop
        
    End If


    '   tag to whether labels can be added; ie: not to those groups derived from layers:
    CanAddLabels = False
        
    Exit Sub
    
InitFeatureLabels_ERR:
    Debug.Assert 0
    Debug.Print "InitFeatureLabels_ERR: " & Err.Description
    'MsgBox "There was an error initializing labels for features: " & Err.Description
    Resume Next
    
End Sub
'
'   return the I3DProperties from the given ILayer
'
Public Function Get3DPropsFromLayer(pLayer As ILayer) As I3DProperties
On Error GoTo EH

Dim i As Integer
Dim pLayerExts As ILayerExtensions
    

    Set pLayerExts = pLayer
'   get 3d properties from extension;
'   layer must have it if it is in scene:
    
    For i = 0 To pLayerExts.ExtensionCount - 1
        Dim p3DProps As I3DProperties
        Set p3DProps = pLayerExts.Extension(i)
        If (Not p3DProps Is Nothing) Then
            Set Get3DPropsFromLayer = p3DProps
            Exit Function
        End If
    Next
    
    Exit Function
    
EH:

End Function

Public Property Get name() As String
    name = LayerName

End Property
Public Property Let name(sName As String)
    LayerName = sName

End Property

Friend Sub DrawLabels(ByVal pViewer As esri3DAnalyst.ISceneViewer)
Dim pDDDText As IDDDText

On Error GoTo DrawLabels_ERR

'   call routine to calculate billboarding info:
    'If BillBoarding Then
        CalcBillboarding pViewer
    'End If

'   set up gl:
    glEnable glcLighting

'   for each label in the collection, call it's draw routine:
    If Not Labels Is Nothing Then
        For Each pDDDText In Labels
            pDDDText.Draw pViewer
        Next pDDDText
    End If

    Exit Sub
    
DrawLabels_ERR:
    Debug.Print "DrawLabels_ERR " & Err.Description
    Resume Next
    
End Sub


Friend Sub AddLabelDirect(pDDD As IDDDText)

On Error GoTo AddLabelDirect_ERR

'   just add the IDDDText to the label collection:
    If Labels Is Nothing Then
        Set Labels = New Collection
    End If
    Labels.Add pDDD
    
    m_bb_haschanged = False
    m_fs_haschanged = False
    m_fn_haschanged = False
    m_fc_haschanged = False
    m_xr_haschanged = False
    m_yr_haschanged = False
    m_zr_haschanged = False
    m_vs_haschanged = False
    m_md_haschanged = False


    Exit Sub
    
AddLabelDirect_ERR:
    Debug.Print "AddLabelDirect_ERR: " & Err.Description
    Resume Next
    
End Sub

Private Sub Class_Initialize()
    Set Labels = New Collection
    MinimumDisplayDistance = -1
    'Me.ExtentScale = 1
End Sub


'
'   copy properties from group to each label:
'
Public Sub UpdateAll()
On Error GoTo UpdateAll_ERR

Dim pDDD As IDDDText
Dim pColor As IColor
Dim pClone As IClone
Dim xD As Double, yD As Double, zD As Double

    Set pClone = Me.Fontcolor
    Set pColor = pClone.Clone
    
    If Labels Is Nothing Then Exit Sub

    
    For Each pDDD In Me.Labels
        With pDDD
            If m_bb_haschanged Then .AutoAdjust = Me.Billboarding
            
            If m_fs_haschanged Then
                .FontSize = Me.FontSize
            End If
            
            If m_fn_haschanged Then .FontName = Me.FontName
            If m_fc_haschanged Then Set .Color = pColor
            If m_xr_haschanged Then .SetAxisRotation Me.XRotation
            If m_yr_haschanged Then .SetAxisRotation , Me.YRotation
            If m_zr_haschanged Then .SetAxisRotation , , Me.ZRotation
            If m_vs_haschanged Then .Enabled = Me.Visible
            If m_md_haschanged Then .MinDisplayDist = Me.MinimumDisplayDistance
            
            
        End With
        
        
    Next
    
'   clear status flags:
    Me.NoUpdatesNeeded


    Exit Sub
    
UpdateAll_ERR:
    Debug.Assert 0
    Debug.Print "UpdateAll: " & Err.Description
    
End Sub



Public Property Get MinimumDisplayDistance() As Double
    MinimumDisplayDistance = m_nMinDispDist
End Property

Public Property Let MinimumDisplayDistance(ByVal vNewValue As Double)
    m_nMinDispDist = vNewValue
    m_md_haschanged = True
End Property
Public Property Get Visible() As Boolean
    Visible = m_bVisible
End Property

Public Property Let Visible(ByVal vNewValue As Boolean)
    m_bVisible = vNewValue
    m_vs_haschanged = True
End Property
Public Property Get ZRotation() As Double
    ZRotation = m_nZRot
End Property

Public Property Let ZRotation(ByVal vNewValue As Double)
    m_nZRot = vNewValue
    m_zr_haschanged = True
End Property
Public Property Get YRotation() As Double
    YRotation = m_nYRot
End Property

Public Property Let YRotation(ByVal vNewValue As Double)
    m_nYRot = vNewValue
    m_yr_haschanged = True
End Property
Public Property Get XRotation() As Double
    XRotation = m_nXRot
End Property

Public Property Let XRotation(ByVal vNewValue As Double)
    m_nXRot = vNewValue
    m_xr_haschanged = True
End Property

Public Property Get Fontcolor() As IRgbColor
    Set Fontcolor = m_pFontcolor
End Property

Public Property Set Fontcolor(ByVal vNewValue As IRgbColor)
    Set m_pFontcolor = vNewValue
    m_fc_haschanged = True
End Property
Public Property Get FontName() As String
    FontName = m_sFontName
End Property

Public Property Let FontName(ByVal vNewValue As String)
    m_sFontName = vNewValue
    m_fn_haschanged = True
End Property
Public Property Get FontSize() As Double
On Error GoTo GetFontSize_ERR


    FontSize = (m_nFontSize / m_nXScale)
    
    Exit Property
    
GetFontSize_ERR:
    MsgBox "error getting fontsize: " & m_nFontSize
End Property

Public Property Let FontSize(ByVal vNewValue As Double)

    m_nFontSize = vNewValue * m_nXScale
    m_fs_haschanged = True
    
End Property
Public Property Get Billboarding() As Boolean
    Billboarding = m_bBillboarding
End Property

Public Property Let Billboarding(ByVal vNewValue As Boolean)
    m_bBillboarding = vNewValue
    m_bb_haschanged = True
End Property

Friend Sub NoUpdatesNeeded()
On Error Resume Next

    m_bb_haschanged = False
    m_fs_haschanged = False
    m_fn_haschanged = False
    m_fc_haschanged = False
    m_xr_haschanged = False
    m_yr_haschanged = False
    m_zr_haschanged = False
    m_vs_haschanged = False
    m_md_haschanged = False
End Sub