vb+ao鹰眼图代码

huangyustar

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

xinxin7450

AO在线上画注记AO在线上画注记