vb+ao鹰眼图代码

Dim pMainMap As IMap

Dim pMainAV As IActiveView

Dim pOverMap As IMap

Dim pOverAV As IActiveView

Dim pOverGraCon As IGraphicsContainer

Dim pEnv As IEnvelope

 

Private Sub Form_Load()

 

Set pMainMap = MapControl1.Map

Set pMainAV = pMainMap

Set pOverMap = MapControl2.Map

Set pOverAV = pOverMap

Set pOverGraCon = pOverAV

 

 

pOverAV.Extent = MapControl2.FullExtent

pOverAV.PartialRefresh esriViewDrawPhase.esriViewGeography, Nothing, Nothing

 

End Sub

 

Private Sub MapControl1_OnAfterScreenDraw(ByVal hdc As Long)

 

'两个控件保持保持一致

Set pEnv = pMainAV.Extent

 

Dim pOverEle As IFillShapeElement

Set pOverEle = getEnvEle(pEnv)

pOverGraCon.DeleteAllElements

pOverGraCon.AddElement pOverEle, 0

'刷新鸟瞰控件视图

pOverAV.PartialRefresh esriViewDrawPhase.esriViewGeography, Nothing, Nothing

 

 

End Sub

 

Private Sub MapControl2_onMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)

 

Dim pPt As IPoint

Set pPt = New Point

pPt.PutCoords mapX, mapY

 

'改变主控件的视图范围

pEnv.CenterAt pPt

pMainAV.Extent = pEnv

 

pMainAV.PartialRefresh esriViewDrawPhase.esriViewGeography, Nothing, Nothing

 

End Sub

' 产生颜色的函数

Private Function getEnvEle(ByVal pEnv As IEnvelope) As IFillShapeElement

Dim pEle As IElement

Dim pFillShapeEle As IFillShapeElement

Set pFillShapeEle = New RectangleElement

Set pEle = pFillShapeEle

 

'颜色产生器

Dim pColor As IRgbColor

Set pColor = New RgbColor

pColor.Red = 255

pColor.Green = 0

pColor.Blue = 0

pColor.Transparency = 255

 

'线符号

Dim pLineSym As ISimpleLineSymbol

Set pLineSym = New SimpleLineSymbol

pLineSym.Color = pColor

pLineSym.Style = esriSimpleLineStyle.esriSLSSolid

pLineSym.Width = 1

 

'填充符号

Dim pFillSym As IFillSymbol

Set pFillSym = New SimpleFillSymbol

pColor.Transparency = 0

pFillSym.Color = pColor

pFillSym.Outline = pLineSym

 

pEle.Geometry = pEnv

pFillShapeEle.Symbol = pFillSym

Set getEnvEle = pFillShapeEle

'Return pFillShapeEle

End Function