vba16-6.txt

ao的一些代码集合

Public Function PlaceOverviewMapFrame() As IElement
    ' Position the overview map frame
    ' in the upper rigth corner.
    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 pElement As IElement
    Dim pEnvelope As IEnvelope
    Dim pMapFrame As IMapFrame
    Dim pDetailMapFrame As IMapFrame
    Dim pTransform2d As ITransform2D
    Dim pPoint As IPoint
    Dim dblXMove As Double
    Dim dblYMove As Double
    Dim pLocatorRectangle As ILocatorRectangle
    Dim pBorder As IBorder
    Dim pSymbolBorder As ISymbolBorder
    Dim pLineSymbol As ILineSymbol
    Dim pRGBColor As IRgbColor
    ' Get the page size.
    Set pMxDocument = Application.Document
    Set pPageLayout = pMxDocument.PageLayout
    Set pActiveView = pPageLayout
    Set pPage = pPageLayout.Page
    pPage.QuerySize dblPageWidth, dblPageHeight
    dblMargin = c_dblMargin
    ' Overview map frame's new width
    ' and height are 2 inches.
    dblFrameWidth = 2
    dblFrameHeight = 2
    ' Access the overview map frame.
    Set pElement = GetMapFrameByName("OVERVIEW")
    If pElement Is Nothing Then
        MsgBox "Missing Overview map."
        Set PlaceOverviewMapFrame = Nothing
        Exit Function
    End If
    ' Get the map frame's
    ' current size.
    Set pEnvelope = New Envelope
    pElement.QueryBounds pActiveView.ScreenDisplay, _
    pEnvelope
    Set pMapFrame = pElement
    pMapFrame.ExtentType = esriExtentDefault
    ' Resize and move the overview map frame.
    Set pTransform2d = pMapFrame
    Set pPoint = New Point
    pPoint.X = pEnvelope.XMin
    pPoint.Y = pEnvelope.YMax
    With pTransform2d
        .Scale pPoint, _
        dblFrameWidth / pEnvelope.Width, _
        dblFrameHeight / pEnvelope.Height
    End With
    dblXMove = dblPageWidth - _
    (dblMargin + dblFrameWidth) - pEnvelope.XMin
    dblYMove = (dblPageHeight - dblMargin) - _
    pEnvelope.YMax
    pTransform2d.Move dblXMove, dblYMove
    ' Add the extent box to the overview map.
    ' Change the extent rectangle
    ' color to red.
    pMapFrame.RemoveAllLocatorRectangles
    Set pLocatorRectangle = New LocatorRectangle
    Set pDetailMapFrame = GetMapFrameByName("DETAIL")
    Set pLocatorRectangle.MapFrame = pDetailMapFrame
    Set pBorder = pLocatorRectangle.Border
    Set pSymbolBorder = pBorder
    Set pLineSymbol = pSymbolBorder.LineSymbol
    Set pRGBColor = New RgbColor
    pRGBColor.Red = 255
    pRGBColor.Green = 0
    pRGBColor.Blue = 0
    pLineSymbol.Color = pRGBColor
    pLineSymbol.Width = 1.5
    pSymbolBorder.LineSymbol = pLineSymbol
    pLocatorRectangle.Border = pSymbolBorder
    pMapFrame.AddLocatorRectangle pLocatorRectangle
    ' Done
    Set PlaceOverviewMapFrame = pElement
End Function