vba16-9.txt

来自「本书给出了AO的常用的VAB代码 可能是初学者很好的一本参考书」· 文本 代码 · 共 65 行

Private Sub AddLegend(pElement As IElement)
    ' Add a legend for the given
    ' map frame.
    Dim pMxDocument As IMxDocument
    Dim pPageLayout As IPageLayout
    Dim pPage As IPage
    Dim pActiveView As IActiveView
    Dim dblPageWidth As Double
    Dim dblPageHeight As Double
    Dim dblMargin As Double
    Dim dblFrameWidth As Double
    Dim dblFrameHeight As Double
    Dim pMapFrame As IMapFrame
    Dim pMapSurroundFrame As IMapSurroundFrame
    Dim pLegendElement As IElement
    Dim pEnvelope As IEnvelope
    Dim pFrameElement As IFrameElement
    Dim pGraphicsContainer As IGraphicsContainer
    Dim pID As New UID
    Dim pMapSurround As IMapSurround
    Dim dblX As Double
    Dim dblY As Double
    ' Get the page size.
    Set pMxDocument = Application.Document
    Set pPageLayout = pMxDocument.PageLayout
    Set pActiveView = pPageLayout
    Set pGraphicsContainer = pPageLayout
    Set pPage = pPageLayout.Page
    pPage.QuerySize dblPageWidth, dblPageHeight
    dblMargin = c_dblMargin
    ' Frame width is 2 inches. Frame
    ' height is page height less the margins
    ' and 2 inches for overview map.
    dblFrameWidth = 2
    dblFrameHeight = dblPageHeight - (2 * dblMargin + 2)
    ' Create a legend map surround.
    Set pMapFrame = pElement
    pID.Value = "esriCore.Legend"
    Set pMapSurround = New Legend
    Set pMapSurroundFrame = pMapFrame. _
    CreateSurroundFrame(pID, pMapSurround)
    ' Size and position the new legend frame.
    Set pFrameElement = pMapSurroundFrame
    Set pLegendElement = pFrameElement
    Set pEnvelope = New Envelope
    ' X and Y of the frame's
    ' upper left corner
    dblX = dblPageWidth - (dblMargin + dblFrameWidth)
    dblY = dblPageHeight - (dblMargin + 2)
    pEnvelope.PutCoords dblX, _
		(dblY - dblFrameHeight + 2), _
    (dblX + dblFrameWidth), dblY
    ' Draw a rectangle around the
    ' legend frame.
    AddRectangle pEnvelope
    ' scale down the rectangle to _
    ' place the legend inside the
    ' drawn rectangle.
    pEnvelope.Expand 0.9, 0.9, True
    pLegendElement.Geometry = pEnvelope
    ' Add the legend to the page layout.
    pLegendElement.Activate pActiveView.ScreenDisplay
    pGraphicsContainer.AddElement pLegendElement, 0
End Sub