鼠标移动到地图边界时，自动漫游[原创]

程序中默认加载了一个图层，大家可以修改，程序不够完善，希望大家改进，呵呵！程序在于交流。

Option Explicit
Private Const PAN_INTERVAL = 250
Private ptMouseMove As MapObjects2.Point
Private rectDynEdge As MapObjects2.Rectangle
Private dPanDist As Double

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Timer1.Enabled = False

End Sub

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Set ptMouseMove = Map1.ToMapPoint(X, Y)

Set rectDynEdge = Map1.Extent
rectDynEdge.ScaleRectangle 0.9

dPanDist = Map1.Extent.Width / 10

Timer1.Enabled = Not rectDynEdge.IsPointIn(ptMouseMove)

End Sub

Private Sub Timer1_Timer()

Dim ptNewCenter As MapObjects2.Point
Set ptNewCenter = Map1.Extent.Center

If ptMouseMove.X < rectDynEdge.Left Then
  ptNewCenter.X = ptNewCenter.X - dPanDist
 ElseIf ptMouseMove.X > rectDynEdge.Right Then
  ptNewCenter.X = ptNewCenter.X + dPanDist
End If

If ptMouseMove.Y < rectDynEdge.Bottom Then
  ptNewCenter.Y = ptNewCenter.Y - dPanDist
 ElseIf ptMouseMove.Y > rectDynEdge.Top Then
  ptNewCenter.Y = ptNewCenter.Y + dPanDist
End If

Map1.CenterAt ptNewCenter.X, ptNewCenter.Y

End Sub

Private Sub Form_Load()

Dim dc As New MapObjects2.DataConnection
Dim mlyr As New MapObjects2.MapLayer
dc.Database = App.Path
dc.Connect
Set mlyr.GeoDataset = dc.FindGeoDataset("states")
mlyr.Symbol.Color = RGB(150, 150, 0)  'olive
Map1.Layers.Add mlyr

'使全图显示的范围少于全图
Dim rect As MapObjects2.Rectangle
Set rect = Map1.FullExtent
rect.ScaleRectangle 2
Set Map1.FullExtent = rect

'放大地图
With rect
  .Left = -121
  .Right = -112
  .Bottom = 30
  .Top = 37
End With
Set Map1.Extent = rect

'设置时钟
Timer1.Interval = PAN_INTERVAL

End Sub

最好说明你修改的部分，大家看看?

好

还是斑竹牛！<img src="images/post/smile/dvbbs/em06.gif" />

斑竹万岁！

可能是增加了trackinglayer的原因,也请大家 看看仔细,最好是具体分析,<img src="images/post/smile/dvbbs/em10.gif" />

支持

D

晕，大家给点意见啊，哈哈，别顶死了！

请问vans，你解决了向屏幕看不到得地方画线得问题了吗