两个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
原理:由于两个控件载入的数据都是一样的,因此,主控件的视图范围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