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

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

在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

[资料名称]：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标准的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

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

上面的值是picture的宽度值。。

MapX4.5实现表紧缩

CMapXLayer layer = m_ctrlMapX.GetLayers().Item(m_ctrlMapX.GetLayers().GetCount());

VARIANT vtLayer;
vtLayer.vt = VT_DISPATCH;
vtLayer.pdispVal = layer.m_lpDispatch;
CMapXDataset dataSet = m_ctrlMapX.GetDatasets().Add(miDataSetLayer, vtLayer,"pack");

CString dsname = m_ctrlMapX.GetDatasets().Item(1).GetName();
CString layername = layer.GetName();
CString layerFilespec = layer.GetFilespec();

//将layer上的内容复制到临时表中
CMapXLayerInfo m_LayerInfo;
m_LayerInfo.CreateDispatch(m_LayerInfo.GetClsid());
m_LayerInfo.SetType(6); //临时表(miLayerInfoTypeTemp)

VARIANT vtparam1;
vtparam1.vt = VT_BSTR;
vtparam1.bstrVal = CString("MemTable").AllocSysString();
m_LayerInfo.AddParameter("TableStorageType", vtparam1);

VARIANT vtparam2;
vtparam2.vt = VT_BSTR;
vtparam2.bstrVal = CString("lyrpack").AllocSysString();
m_LayerInfo.AddParameter("Name", vtparam2);


VARIANT m_Fields;
CMapXFields n_Fields;
n_Fields.CreateDispatch(n_Fields.GetClsid());
n_Fields=dataSet.GetFields();
m_Fields.vt = VT_DISPATCH;
m_Fields.pdispVal = n_Fields.m_lpDispatch;
m_LayerInfo.AddParameter("Fields", m_Fields);


VARIANT m_Features;
CMapXFeatures n_Features=layer.AllFeatures();

m_Features.vt = VT_DISPATCH;
m_Features.pdispVal=n_Features.m_lpDispatch;
m_LayerInfo.AddParameter("Features", m_Features);

CMapXLayer packlyr = m_ctrlMapX.GetLayers().Add(m_LayerInfo);
//已将layer复制到临时表中

//从地图窗口

m_ctrlMapX.GetDatasets().Remove("pack");
m_ctrlMapX.GetLayers().Remove(layername);


//创建dataset for packlyr
vtLayer.vt = VT_DISPATCH;
vtLayer.pdispVal = packlyr.m_lpDispatch;
dataSet = m_ctrlMapX.GetDatasets().Add(miDataSetLayer, vtLayer,"pack");

//创建新表
CMapXLayerInfo newlayerInfo;
newlayerInfo.CreateDispatch(newlayerInfo.GetClsid());
newlayerInfo.SetType(7); //新表(miLayerInfoTypeNewTalbe)

newlayerInfo.AddParameter("filespec",COleVariant(layerFilespec));

newlayerInfo.AddParameter("Name", COleVariant(layername));

n_Fields=dataSet.GetFields();
m_Fields.vt = VT_DISPATCH;
m_Fields.pdispVal = n_Fields.m_lpDispatch;
newlayerInfo.AddParameter("Fields", m_Fields);

CMapXFeatures features = packlyr.AllFeatures();
VARIANT fs;
fs.vt = VT_DISPATCH;
fs.pdispVal=features.m_lpDispatch;
newlayerInfo.AddParameter("features",fs);

newlayerInfo.AddParameter("OverwriteFile",COleVariant("1"));

long lPosition = 4;//m_ctrlMapX.GetLayers().GetCount();
VARIANT newlyr;
newlyr.vt=VT_DISPATCH;
newlyr.pdispVal=newlayerInfo.m_lpDispatch;

VARIANT lp;
lp.vt = VT_I4;
lp.lVal = lPosition;
m_ctrlMapX.GetLayers().Add(newlayerInfo.m_lpDispatch);
m_ctrlMapX.GetLayers().Move(2,(short)m_ctrlMapX.GetLayers().GetCount());

//删除临时表
m_ctrlMapX.GetDatasets().Remove("pack");
m_ctrlMapX.GetLayers().Remove("lyrpack");

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