我还是不知道在测距时，如何实现自动漫游屏幕（像mapinfo在量算距离的范围超出当前屏幕显示的视野范围时，鼠标移动到屏幕边界就会自动的漫游）？？？？

自定义选择与自动滚屏[转载]
以下代码创建选择工具（框选、圈选、多边形选择）而不使用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

谢谢

[资料名称]：access表-->MI表的两种途径
[资料内容]：access表-->MI表有两种途径：1.bindlayerXY方式绑定。指定bindlayer.filespec就可以创建永久表，不指定则为临时表。只能创建一个字段，GeoName,来源于City字段。当City字段不能唯一是，state字段用于限定。不能创建索引。2.layerInfo新建表。可以创建多个字段
。mapx5中可以创建索引，mapx4中不可以。

详细内容可以参考：http://www.gmcfc.com/mapxzj/dispbbs.asp?boardID=2&ID=141
或者：
1.bindlayerXY方式绑定。
指定bindlayer.filespec就可以创建永久表，不指定则为临时表。

Private Sub Command4_Click()
'只能创建一个字段，GeoName,来源于City字段。当City字段不能唯一是，state字段用于限定。
'不能创建索引
Dim BindlayerObject As New mapxlib.BindLayer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ds As mapxlib.Dataset

Set db = DBEngine.WorkSpaces(0).Opendatabase("C:\Program Files\MapInfo\MapX 4.0\Data\Mapstats.mdb")
Set rs = db.OpenRecordset("US_Cust")

BindlayerObject.LayerName = "新图层名"
BindlayerObject.Filespec = App.Path + "\mytab.tab"   '若不指定,则为临时表
BindlayerObject.RefColumn1 = "X"
BindlayerObject.RefColumn2 = "Y"
BindlayerObject.LayerType = miBindLayerTypeXY

Set ds = Map1.Datasets.Add(miDataSetDAO, rs, "数据集名", "City", "State", BindlayerObject)
End Sub


2.layerInfo新建表
layers.add lyrinfo创建好一个有完备字段的空表
      ds.rowvalues,  
      lyr.addfeature ftr,rvs填入图元和属性

Private Sub Command1_Click()
'可以创建多个字段
'mapx5中可以创建索引，mapx4中不可以
     Dim rs As DAO.Recordset
     Dim db As DAO.Database
    
     Dim flds As New MapXLib.Fields

     Dim lyrNew As MapXLib.Layer
     Dim ptNew As New MapXLib.Point
     Dim ftrNew As MapXLib.Feature
     Dim ff As MapXLib.FeatureFactory
     Dim li As New MapXLib.LayerInfo
     Dim rvs As New MapXLib.Rowvalues
     Dim ds As MapXLib.Dataset

     Set db = DBEngine.OpenDatabase("C:\Program Files\MapInfo\MapX 4.0\data\mapstats.mdb")
     Set rs = db.OpenRecordset("US_Cust")
    
     Set ff = Map1.FeatureFactory
    
     flds.AddStringField "Company", 50 ,true   'mapx5中可以创建索引，
     'flds.AddStringField "Company", 50    'mapx4中不可以创建索引，
     flds.AddStringField "City", 50
     flds.AddStringField "State", 2
     flds.AddNumericField "Order_Amt", 12, 2

 
     li.Type = miLayerInfoTypeNewTable
     li.AddParameter "FileSpec", App.Path & "\custtab.tab"
     li.AddParameter "Name", "mycustomers"
     li.AddParameter "Fields", flds

    
     Map1.Layers.Add li, 1
     '到此为止，已经用access表建好mapinfo表，也设置好了字段，但是没有图元在上面，也没有记录。
     '下面从access表中x,y创建点图元，同时把其属性数据也添加进去
    '--------------------------------------------------------------------

     Set lyrNew = Map1.Layers(1)
     Set ds = Map1.Datasets.Add(miDataSetLayer, lyrNew)
     Set rvs = ds.Rowvalues(0)
    
     rs.MoveFirst
     Do While Not rs.EOF
          rvs.Item("Company").value = rs.Fields("Company") 'rvs.Item("Company")可写为rvs("Company")
          rvs.Item("City").value = rs.Fields("City")
          rvs.Item("State").value = rs.Fields("State")
          rvs.Item("Order_Amt").value = rs.Fields("Order_Amt")
        
          ptNew.Set rs.Fields("X"), rs.Fields("Y")
          Set ftrNew = ff.CreateSymbol(ptNew)
          Set ftrNew = lyrNew.AddFeature(ftrNew, rvs)  '  图元+属性，即feature+Rowvalues
          'Set ftrNew = lyrNew.AddFeature(ftrNew)
          'ftrNew.Update True, rvs
          
          rs.MoveNext
     Loop

     Set rs = Nothing
    Set db = Nothing
End Sub

在mapx中如何实现图元的拖拽（转贴 是yesgis的）
在mapx中如何实现图元的拖拽
以下方法实现将选中图元移到点击处。
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ftr As Feature
Dim lyr As Layer
Dim MapX As Double
Dim MapY As Double
'convert where the mouse is clicked to the map's current coordinate system
Map1.ConvertCoord X, Y, MapX, MapY, miScreenToMap
'iterate through each selected feature in each layer
For Each lyr In Map1.Layers
For Each ftr In lyr.Selection

'change the offset of the feature
ftr.Offset MapX - ftr.CenterX, MapY - ftr.CenterY
'update the feature to make the change permanent
ftr.Update
Next
Next
End SUb

mapx中创建测距工具示例（转贴）
mapx中创建测距工具示例
首先创建测距工具
global const calculatedistance=1
Private Sub Form_Load()
map1.CreateCustomTool(calcilatedistance,miToolTypepoly ,microsscursor)
End Sub
Private Sub Distances_Click()
map1.currenttool=calculatetool
End Sub


然后在mapx的PolyToolUsed事件中， 用Distance( x1,y1,x2,y2 )计算距离，由状态条中或label显示。
Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal Flags As Long, ByVal points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)

Dim DisSum As Double
Dim Dis As Double
Dim n As Integer
Dim pts As New MapXLib.points
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double

Set pts = points

DisSum = 0
MDIForm1.StatusBar1.Panels.Item(3).Text= Format(Str(DisSum), "#,##0.000000")

Select Case Flags
Case miPolyToolBegin
Case miPolyToolInProgress
If ToolNum = CalculateDistance Then
For i = 1 To pts.Count - 1
x1 = pts.Item(i).X
y1 = pts.Item(i).Y
x2 = pts.Item(i + 1).X
y3 = pts.Item(i + 1).Y
Dis = Map1.Distance(x1, y1, x2, y2)
DisSum = DisSum + Dis
MDIForm1.StatusBar1.Panels.Item(3).Text = Format(Str(DisSum), "#,##0.000000")
Next i
End If

Case miPolyToolEnd

End Select

非常的感谢大家，各位前辈！！！！！！！！
等着日后学成之时，定要在这里贴，贴，一定。

hao

<P>那位知道为什么我的打包程序建立不了快捷方式啊</P>

<P><b>MAP控件的水平垂直滚动条</b></P><P>procedure TForm1.Timer1Timer(Sender: TObject);
var
xp,yp,xr,yr,w,h:integer;
begin
//**********&micro;&Oslash;&Iacute;&frac14;&Ecirc;&Oacute;&Ograve;°&Euml;&aelig;scrollbox&micro;&Auml;&sup1;&ouml;&para;&macr;&Igrave;&otilde;&cedil;&Auml;±&auml;&para;&oslash;&cedil;&Auml;±&auml;**************
if (map1.Top<>0) or (map1.Left<>0) then
begin
xp:=scrollbox1.HorzScrollBar.Position;
yp:=scrollbox1.VertScrollBar.Position;
xr:=scrollbox1.HorzScrollBar.Range;
yr:=scrollbox1.VertScrollBar.Range;
w:=map1.Width;
h:=map1.Height;
map1.CenterX:=(xp-(xr-w)/2)*(map2.Bounds.XMax-map2.Bounds.XMin)/xr+map2.CenterX;
map1.CenterY:=-(yp-(yr-h)/2)*(map2.Bounds.YMax-map2.Bounds.YMin)/yr+map2.CenterY;
map1.Top:=0;
map1.Left:=0;
end;
//<<<<<<<*****************************************************
end;</P>