欢迎您来到GIS动力

加入收藏 免费注册 用户登陆 帮助中心
首页 新闻动态 技术专栏 银杏树下 学习考研 软件下载 求职招聘 许愿瓶 节日祝福 用户中心 精彩推荐 资源搜索 地图
专栏导航: AO开发 | SO开发 | ArcGIS桌面 | 超图桌面 | 开发语言 | 数据库 | WebGIS | 银杏文学 | 研究生考题 | FreeMap FreeTalk
   您现在位于: 首页技术专栏ArcGIS应用与开发AO开发 → 正文
添加图例代码
07-12-14 00:00:00 作者:峰哥 出处:SINA博客
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


(本文已被浏览 次)
发布人:admin
推荐给好友:发送给好友
上篇新闻:
下篇新闻:
相关评论
发表我的评论
  • 尊重网上道德,遵守《全国人大常委会关于维护互联网安全的决定》及中华人民共和国其他各项有关法律法;
  • 本站有权保留或删除您发表的任何评论内容;
  •   相关文章  
    无相关新闻

    关于我们友情链接 ┋ 与我在线 ┋ 管理 ┋ TOP
     
    网站当前版本:GisPower CMS V3.0
    『GIS 动力』- http://www.gispower.org/
    联系我们:webmaster#gispower.org
    Copyright (c) 2003-2007 GisPOwer.Org. All Rights Reserved.
     

                   滇ICP备05006901号