如何在Page Layout上添加Legend

Question

如题所述

Answer 1

本例要实现的功能是以鼠标在Page Layout上画的Envelope为范围在Pagelayout增加一个跟第一个层相关联的图例。
　　要实现本例的功能首先需要在PageLayout上创建一个Legend元素，然后再设置该元素的属性，其中用到了两个主要的接口：ILegend和IlegendItem。
　　ILegend用来控制Legend（图例）。以下是该接口成员的介绍：
　　Layer：实现与相关层的关联；
　　Columns：图例以几列显示；
　　ShowDescription 、ShowHeading、ShowLabels、ShowLayerName: 分别表示描述、标题、分类、层名称是否显示；
　　IlegendItem用来设置Legend的风格。以下是该接口成员的介绍：
　　AddItem ：在图例的最后添加一项；
　　ClearItem：清除所有项；
　　Title：设置标题。
　　? 程序说明
　　函数CreateLegend根据传入的pExtent参数在PageLayout上添加一个Legend元素。
　　? 代码
　　Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _
　　 ByVal y As Long)
　　 Dim pMxDocument As IMxDocument
　　 Dim pActiveView As IActiveView
　　 Dim pEnvelope As IEnvelope
　　 Dim pFeatureLayer As IFeatureLayer
　　 Dim pRubberBand As IRubberBand
　　 On Error GoTo ErrorHandler
　　
　　 Set pMxDocument = ThisDocument
　　 '确保AcrMap在Layout模式下
　　 '确保AcrMap中有数据
　　 If Not pMxDocument.ActiveView Is pMxDocument.PageLayout Or pMxDocument.FocusMap.LayerCount = 0 Then
　　 Exit Sub
　　 End If
　　 '初始设定
　　 Set pActiveView = pMxDocument.PageLayout
　　 Set pRubberBand = New RubberEnvelope
　　 'IRubberBand接口用于画Envelope,Polygon等
　　 Set pEnvelope = pRubberBand.TrackNew(pMxDocument.ActiveView.ScreenDisplay, Nothing)
　　 Set pFeatureLayer = pMxDocument.FocusMap.Layer(0)
CreateLegend pEnvelope, pFeatureLayer, pActiveView
　　 pActiveView.Refresh
　　 Exit Sub
　　ErrorHandler:
　　 MsgBox Err.Description
　　End Sub
　　
　　Public Sub CreateLegend(pExtent As IEnvelope, pFeatureLayer As IFeatureLayer, _
　　 pActiveView As IActiveView)
　　 Dim pMapFrame As IMapFrame
　　 Dim pMapSurroundF As IMapSurroundFrame
　　 Dim pMapSurround As IMapSurround
　　 Dim pLegend As ILegend
　　 Dim pLegendItem As ILegendItem
　　 Dim pElement As IElement
　　 Dim pAreaLayer As IFeatureLayer
　　 Dim pTextSymbol As ITextSymbol
　　 Dim pFillSymbol As IFillSymbol
　　 Dim pLineSymbol As ILineSymbol
　　 Dim pColor As IColor
　　 Dim pSymbolBackground As ISymbolBackground
　　Dim pUID As New UID
　　
　　 On Error GoTo ErrorHandler
　　
　　If pFeatureLayer Is Nothing Then Exit Sub
　　 If pActiveView Is Nothing Then Exit Sub
　　 If Not TypeOf pActiveView Is IPageLayout Then Exit Sub
　　 '得到MapFrame
　　 Set pMapFrame = pActiveView.GraphicsContainer.FindFrame(pActiveView.FocusMap)
　　 pUID.Value = "esriCore.Legend"
　　 Set pMapSurroundF = pMapFrame.CreateSurroundFrame(pUID, Nothing)
　　 '创建底图Symbol
　　 Set pSymbolBackground = New esriCore.SymbolBackground
　　 Set pFillSymbol = New esriCore.SimpleFillSymbol
　　 Set pLineSymbol = New esriCore.SimpleLineSymbol
　　 Set pColor = New esriCore.RgbColor
　　 pColor.RGB = RGB(255, 255, 255)
pLineSymbol.Color = pColor
　　 pFillSymbol.Color = pColor
　　 pFillSymbol.Outline = pLineSymbol
　　 pSymbolBackground.FillSymbol = pFillSymbol
　　 pMapSurroundF.Background = pSymbolBackground
　　 Set pElement = pMapSurroundF
　　 pElement.Geometry = pExtent
　　 Set pMapSurround = pMapSurroundF.MapSurround
　　 Set pLegend = pMapSurround
　　 '创建一个水平的LegendItem
　　 Set pLegendItem = New esriCore.HorizontalLegendItem
　　 '设置LegendItem的相关层和列数
　　 With pLegendItem
　　 Set .Layer = pFeatureLayer
　　 .Columns = 1
　　 .ShowDescriptions = True
　　 .ShowHeading = True
　　 .ShowLabels = True
　　 .ShowLayerName = True
　　 End With
　　 '先清除所有的LegendItem
　　 pLegend.ClearItems
　　 '在Legend上添加一个LegendItem
　　 With pLegend
　　 .AddItem pLegendItem
　　 .Title = "New Legend"
　　 End With
　　 pActiveView.GraphicsContainer.AddElement pElement, 0
　　 Exit Sub
　　ErrorHandler:
　　 MsgBox Err.Description
　　End Sub