ArcObjects:添加图例代码

 

Private Sub showLegend()
        If Not pGroupElement Is Nothing Then
            pGroupElement.ClearElements()
        End If
        Dim graphicsContainer As IGraphicsContainer
        graphicsContainer = frmMain.AxPageLayoutCtl.GraphicsContainer
        Dim pLegend As ILegend
        Dim pLegendItem As ILegendItem
        Dim mapSurround As IMapSurround

        Dim mapFrame As IMapFrame
        mapFrame = graphicsContainer.FindFrame(frmMain.AxPageLayoutCtl.ActiveView.FocusMap)
        If mapFrame Is Nothing Then Exit Sub

        Dim uID As UID = New UIDClass
        uID.Value = "esriCarto.Legend"

        Dim mapSurroundFrame As IMapSurroundFrame
        mapSurroundFrame = mapFrame.CreateSurroundFrame(uID, Nothing)
        If mapSurroundFrame Is Nothing Then Return
        If mapSurroundFrame.MapSurround Is Nothing Then Return

        mapSurroundFrame.MapSurround.Name = "Legend"
        mapSurround = mapSurroundFrame.MapSurround
        pLegend = mapSurround
        pLegend.Title = txtLegendTitle.Text

        Dim pLForm As ILegendFormat
        pLForm = New LegendFormat
        If Not Me.mAreaStyleItem Is Nothing Then
            pLForm.DefaultAreaPatch = Me.mAreaStyleItem.Item
        End If
        If Not Me.mLineStyleItem Is Nothing Then
            pLForm.DefaultLinePatch = Me.mLineStyleItem.Item
        End If
        With pLForm
            .DefaultPatchWidth = CDbl(txtWidth3.Text)
            .DefaultPatchHeight = CDbl(txtHeight3.Text)
            .HeadingGap = CDbl(Me.txtHeadingGap.Text)
            .TitleGap = CDbl(Me.txtTitleGap.Text)
            .TextGap = CDbl(Me.txtTextGap.Text)
            .VerticalPatchGap = CDbl(Me.txtPatch.Text)
            .VerticalItemGap = CDbl(Me.txtVerticalItemGap.Text)
            .HorizontalItemGap = CDbl(Me.txtColumn.Text)
            .HorizontalPatchGap = CDbl(Me.txtPatchLabel.Text)
            If Me.rbtLeft.Checked = True Then
                .TitlePosition = esriRectanglePosition.esriLeftSide
            ElseIf Me.rbtRight.Checked = True Then
                .TitlePosition = esriRectanglePosition.esriRightSide
            End If
        End With
      

        Dim pTextSym As ITextSymbol
        pTextSym = New TextSymbol

        Dim pColor As IRgbColor
        pColor = New RgbColor
        With txtLegendTitle.ForeColor
            pColor.Red = .R
            pColor.Green = .G
            pColor.Blue = .B
        End With
        pTextSym.Color = pColor

        pTextSym.Font = ESRI.ArcGIS.ADF.COMSupport.OLE.GetIFontDispFromFont(txtLegendTitle.Font)
        pLForm.TitleSymbol = pTextSym
        pLegend.Format = pLForm
        pLegend.ClearItems()

        Dim i As Integer
        For i = 0 To lbxLayerLegend.Items.Count - 1
            pLegendItem = New HorizontalLegendItem
            With pLegendItem
                .Columns = Me.nudColumnNum.Value
                Dim temp As String
                temp = lbxLayerLegend.GetItemText(lbxLayerLegend.Items.Item(i))
                Dim j As Integer
                Dim pFeatlyr As IFeatureLayer
                For j = 0 To frmMain.AxPageLayoutCtl.ActiveView.FocusMap.LayerCount - 1
                    pFeatlyr = frmMain.AxPageLayoutCtl.ActiveView.FocusMap.Layer(j)
                    If pFeatlyr.Name = temp Then
                        Exit For
                    End If
                Next
                .Layer = frmMain.AxPageLayoutCtl.ActiveView.FocusMap.Layer(j)
                .ShowDescriptions = True
                .ShowHeading = True
                .ShowLabels = True
                .ShowLayerName = True
            End With
            pLegend.AddItem(pLegendItem)
        Next

        Dim pFrameProp As IFrameProperties
        pFrameProp = mapSurroundFrame
        If Not Me.mFrameStyleItem Is Nothing Then
            pFrameProp.Border = Me.mFrameStyleItem.Item
        End If
        If Not Me.mBackColorStyleItem Is Nothing Then
            pFrameProp.Background = Me.mBackColorStyleItem.Item
        End If
        If Not Me.mShadowStyleItem Is Nothing Then
            pFrameProp.Shadow = Me.mShadowStyleItem.Item
        End If
        Dim envelope As IEnvelope = New EnvelopeClass
        envelope.PutCoords(1, 1, 3.4, 2.4)
        Dim element As IElement
        element = mapSurroundFrame
        element.Geometry = envelope
        pGroupElement.AddElement(element)

        frmMain.AxPageLayoutCtl.AddElement(pGroupElement, Type.Missing, Type.Missing, "Legend", 0)
        frmMain.AxPageLayoutCtl.ActiveView.PartialRefresh(esriViewDrawPhase.esriViewGraphics, Nothing, Nothing)

    End Sub