主控件与鸟瞰控件的联动

两个MapControl控件，一个作为主控件，另一个作为鸟瞰控件，当主控件的视图变化时，鸟瞰控件的出现一个红色的框标识主控件的显示区域，如果在鸟瞰控件上点击，也会改变主控件的显示范围。

原理：由于两个控件载入的数据都是一样的，因此，主控件的视图范围Extent和鸟瞰控件红框的Envelope是一致的，两个控件尽管大小不一样，但视图范围一致。

代码：
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 Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
pMainMap = AxMapControl1.Map
pMainAV = pMainMap
pOverMap = AxMapControl2.Map
pOverAV = pOverMap
pOverGraCon = pOverAV

'让鸟瞰控件中载入和主控件一样的地图
Dim iLayer As Integer
For iLayer = 0 To pMainMap.LayerCount - 1
pOverMap.AddLayer(pMainMap.Layer(iLayer))
Next
pOverAV.Extent = AxMapControl2.FullExtent
pOverAV.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, Nothing)
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub AxMapControl1_OnAfterScreenDraw(ByVal sender As Object, ByVal e As ESRI.ArcGIS.Controls.IMapControlEvents2_OnAfterScreenDrawEvent) Handles AxMapControl1.OnAfterScreenDraw
'两个控件保持保持一致
pEnv = pMainAV.Extent

Dim pOverEle As IFillShapeElement
pOverEle = getEnvEle(pEnv)

'首先删除鸟瞰控件中的所有Element，为什么？大家可以想想
pOverGraCon.DeleteAllElements()
pOverGraCon.AddElement(pOverEle, 0)
'刷新鸟瞰控件视图
pOverAV.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, Nothing)
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub AxMapControl2_OnMouseDown(ByVal sender As System.Object, ByVal e As ESRI.ArcGIS.Controls.IMapControlEvents2_OnMouseDownEvent) Handles AxMapControl2.OnMouseDown
Dim pPt As IPoint
pPt = New Point
pPt.PutCoords(e.mapX, e.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
pFillShapeEle = New RectangleElement
pEle = pFillShapeEle

'颜色产生器
Dim pColor As IRgbColor
pColor = New RgbColor
pColor.Red = 255
pColor.Green = 0
pColor.Blue = 0
pColor.Transparency = 255

'线符号
Dim pLineSym As ISimpleLineSymbol
pLineSym = New SimpleLineSymbol
pLineSym.Color = pColor
pLineSym.Style = esriSimpleLineStyle.esriSLSSolid
pLineSym.Width = 1

'填充符号
Dim pFillSym As IFillSymbol
pFillSym = New SimpleFillSymbol
pColor.Transparency = 0
pFillSym.Color = pColor
pFillSym.Outline = pLineSym

pEle.Geometry = pEnv
pFillShapeEle.Symbol = pFillSym
Return pFillShapeEle
End Function

Related Items