返回首页
当前位置: 主页 > GPS学院 > 学术论文 >

GPS学术论文 MapX的“鹰眼”实现

时间:2008-01-22 00:55来源:GPS之家-导航之家 作者:www.gpsuu.com
新建一工程,放两个MapX控件:Map1(主),Map2(导航),放三个按钮用来放大、缩小和漫游: CmdZoomIn,CmdZoomOut,CmdPan '本程序演示MapX的鹰眼窗口 '采用MapX的Feature方式实现 Dim m_TempLayer As Layer '导航图上临时图层 Dim m_Fea As MapXLib.Feature '导航图上

新建一工程,放两个MapX控件:Map1(主),Map2(导航),放三个按钮用来放大、缩小和漫游:

 

 

CmdZoomIn,CmdZoomOut,CmdPan

'本程序演示MapX的“鹰眼”窗口
'采用MapX的Feature方式实现
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

(责任编辑:admin)
[ GPSUU整理发布,版权归原作者所有。]
顶一下
(1)
100%
踩一下
(0)
0%
------分隔线----------------------------

推荐内容
图文新闻