关于漫游的问题！急~~~~！

在做距离量算时，量算的范围超出当前屏幕显示范围时怎么实现自动漫游！
<img src="images/post/smile/dvbbs/em12.gif" />

谢谢，十分感谢！

下面的事例供你参考：
自定义选择与自动滚屏[转载]
以下代码创建选择工具（框选、圈选、多边形选择）而不使用mapx标准的tool，同时实现自动滚屏（效果不太好）。

Dim pnt101 As New Point
Dim pnts103 As New Points
Dim lyr As Layer

Private Sub Command1_Click()
Map1.CurrentTool = 101
End Sub

Private Sub Command2_Click()
Map1.CurrentTool = 102
End Sub

Private Sub Command3_Click()
Map1.CurrentTool = 103
End Sub

Private Sub Form_Load()
'init lyr and the first point
pnt101.Set 0, 0
Set lyr = Map1.Layers.AddUserDrawLayer("DrawLyr", 1)
Map1.Layers.CreateLayer ("Temp")
Map1.Layers.Item("temp").Editable = True
Set Map1.Layers.InsertionLayer = Map1.Layers.Item("temp")
Map1.CreateCustomTool 101, miToolTypePoint, 2 'rect tool
Map1.CreateCustomTool 102, miToolTypePoint, 2 'radius tool
Map1.CreateCustomTool 103, miToolTypePoint, 2 'poly tool
End Sub

Private Sub Map1_DblClick()
If Map1.CurrentTool = 103 And pnts103.Count > 1 Then
Set ftr = Map1.FeatureFactory.CreateRegion(pnts103)
ftr.Attach Map1
Set ftr = Map1.Layers.Item("temp").AddFeature(ftr)
Map1.Layers.Item("Us Capitals").Selection.ClearSelection
Map1.Layers.Item("US Capitals").Selection.SelectByRegion Map1.Layers.Item("temp"), ftr, miSelectionNew
pnts103.RemoveAll
Map1.Layers.Item("temp").DeleteFeature ftr
End If
End Sub

Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
Dim ftrs As Features
Dim rect As New Rectangle
If ToolNum = 101 Then
If pnt101.X = 0 And pnt101.Y = 0 Then
pnt101.Set X1, Y1
Else
rect.Set X1, Y1, pnt101.X, pnt101.Y
Set ftrs = Map1.Layers.Item("US Capitals").SearchWithinRectangle(rect, miSearchTypePartiallyWithin)
Map1.Layers.Item("Us Capitals").Selection.ClearSelection
Map1.Layers.Item("Us Capitals").Selection.Add ftrs
pnt101.Set 0, 0
End If
End If
If ToolNum = 102 Then
If pnt101.X = 0 And pnt101.Y = 0 Then
pnt101.Set X1, Y1
Else
Dim dist As Double
dist = Map1.Distance(X1, Y1, pnt101.X, pnt101.Y)
Set ftrs = Map1.Layers.Item("US Capitals").SearchWithinDistance(pnt101, dist, Map1.MapUnit, miSearchTypePartiallyWithin)
Map1.Layers.Item("Us Capitals").Selection.ClearSelection
Map1.Layers.Item("Us Capitals").Selection.Add ftrs
pnt101.Set 0, 0
End If
End If
If ToolNum = 103 Then
pnts103.AddXY X1, Y1
End If
End Sub


Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > Map1.MapScreenWidth - 10 Then
Map1.CenterX = Map1.CenterX + 0.5
Else
If X < 10 Then
Map1.CenterX = Map1.CenterX - 0.5
Else
If Y > Map1.MapScreenHeight - 10 Then
Map1.CenterY = Map1.CenterY - 0.5
Else
If Y < 10 Then
Map1.CenterY = Map1.CenterY + 0.5
End If
End If
End If
End If
End Sub

难道就真的没有人做过这方面的东东吗？？？？急！！！！！

在哪里啊，没有找到？

你可以本论坛置顶的帖子中看看，有相关的内容！
主题名如下：
 [VB+MAPX]功能开发的实现代码共享（只允许贴码跟贴）