『公告』 预祝您龙年大吉,万事如意, 过节期间, 大家如需数据服务,请拨打400 或直接添加客服微信,再祝大家龙年,心想事成。
关注我们 新浪 腾讯

ArcObjects:添加图例代码

ArcObjects:添加图例代码
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

      京ICP备2025132830号-1 京公网安备 号