ArcObjects:添加图例代码
Private Sub showLegend() If Not pGroupElement Is Nothing Then pGroupElement.ClearElements() End If Dim graphicsContainer As IGraphicsContainer graphicsContainer = frmMain.AxPageLayoutCtl.GraphicsCon...
- 作者:峰哥来源:SINA博客|2007年10月23日
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