MapX的“鹰眼”实现（vb）[转帖]

新建一工程，放两个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

我没实验过，期待你们调试了，呵呵