[GIS资料]MapX的“鹰眼”实现

百花草

[GIS资料]MapX的“鹰眼”实现
去年做了MapX方面的毕业设计，现在找到这个方面的资料，和大家共享。下面是转贴。来自张玉洲

新建一工程，放两个MapX控件：Map1（主），Map2（导航），放三个按钮用来放大、缩小和漫游：CmdZoomIn,CmdZoomOut,CmdPan
'本程序演示MapX的“鹰眼”窗口
'采用MapX的Feature方式实现
'如有问题，请和我联系 yz_zhang@263.net（张玉洲）
Dim m_TempLayer As Layer '导航图上临时图层
Dim m_Fea As MapXLib.Feature '导航图上反映主地图窗口位置的Feature
Dim bDown As Boolean '鼠标在导航图上按下的标志
Private Sub CmdPan_Click()
Map1.CurrentTool = miPanTool
End Sub
Private Sub CmdZoomIn_Click()
Map1.CurrentTool = miZoomInTool
End Sub
Private Sub CmdZoomOut_Click()
Map1.CurrentTool = miZoomOutTool
End Sub
Private Sub Form_Load()
''给Map2增加临时图层
Set m_TempLayer = Map2.Layers.CreateLayer("wewew"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set m_Fea = Nothing
Set m_TempLayer = Nothing
End Sub
''根据map1的Bounds在Map2上绘制矩形
Private Sub Map1_MapViewChanged()
Dim tempFea As MapXLib.Feature
Dim tempPnts As MapXLib.Points
Dim tempStyle As MapXLib.Style
If m_TempLayer.AllFeatures.Count = 0 Then '矩形边框还没有
'设置矩形边框样式
Set tempStyle = New MapXLib.Style
tempStyle.RegionPattern = miPatternNoFill
tempStyle.RegionBorderColor = 255
tempStyle.RegionBorderWidth = 2
'在临时图层添加大小为Map1的边界的Rectangle对象
Set tempFea = Map2.FeatureFactory.CreateRegion(Map1.Bounds, tempStyle)
Set m_Fea = m_TempLayer.AddFeature(tempFea)
Set tempStyle = Nothing
Else '根据Map1的视野变化改变矩形边框的大小和位置
With m_Fea.Parts.Item(1)
.RemoveAll
.AddXY Map1.Bounds.XMin, Map1.Bounds.YMin
.AddXY Map1.Bounds.XMax, Map1.Bounds.YMin
.AddXY Map1.Bounds.XMax, Map1.Bounds.YMax
.AddXY Map1.Bounds.XMin, Map1.Bounds.YMax
End With
m_Fea.Update
End If
End Sub
'下面代码和"API方式实现"的一样
Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
bDown = True
Map2.ConvertCoord X, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY
End Sub
Private Sub Map2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
If bDown Then
Map2.ConvertCoord X, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY
End If
End Sub
Private Sub Map2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bDown = False
End Sub

jxqkd123

探矿者软件可以提高矿体的命中率，减少找矿的成本和难度，主要功能：数据管理、二维制图、三维建模、储量估算、三维立体预测等，有需要免费试用可以联系负责人邓帅15377311476（微信同号），软件针对单位或者企业试用，不面向个人试用