摘要 本文介绍了VB中如何利用MapX创建用户定制地图工具，详细地说明了整个创建过程，以及在创建定制工具的过程中所使用的关键方法。
  1.前言
  随着地理信息系统的发展，国内外已出现了不少GIS（地理信息系统）软件，其中MapX是MapInfo公司的ActiveX控件产品。由于它是一种基于Windows操作系统的标准控件，因而MapX4.0支持绝大多数标准的可视化开发环境，如：VisualBasic，Delphi，PowerBuilder，VisualC++等面向对象语言，而且可以使用Lotus Script将MapX4.0嵌入到Lotus Notes中。
  虽然MapX4.0提供了许多标准工具，可以直接使用，但是很多情况下，这些标准工具不能满足实际的需要，这就要求通过定制地图工具来规定工具能完成何种功能，例如画椭圆工具，标尺工具（测线段长度）等等。下面，笔者就通过一具体实例来介绍一下VB中采用MapX4.0控件制作地图的定制工具。
  2.VB环境下MapX编程
  利用MapX4.0创建用户定制工具分为以下三步：
  2.1 创建定制工具
  本例创建的是画椭圆工具。首先，宣称全局常量miAddEllipseTool = 1，1就代表了画椭圆这
个工具。然后，在主窗体中创建画椭圆工具。
关键方法（创建定制工具）：
OBJECT.CreateCustomTool (ToolNumber, Type, Cursor, [ShiftCursor] , [CtrlCursor], [InfoTips])
  OBJECT（对象）：Map对象；
  ToolNumber（工具号）是创建出代表画椭圆工具的miAddEllipseTool；
  Type（类型）：描述了工具的行为，这个参数取的ToolTypeConstants（工具类型常量）值。本例，工具是按下鼠标左键到弹上鼠标左键的过程中画椭圆。本例中取的是miToolTypePoint；
  Cursor（指针形状）：使用该工具时，该工具在地图上显示的形状，该参数从CursorConstants（指针常量）中取值。本例选用的是miCrossCursor，那么当选择该工具时，该工具将在地图上显示成十字叉形状；
ShiftCursor ，CtrlCursor：这两个参数是可选的，缺省情况时，SHIFT键和CTRL键不起作用；
  InfoTips（工具提示）： Boolean型。 如果要显示工具提示，需要将此参数设为true；缺省值为false。
  实际编码：
Public Const miAddEllipseTool = 1 '定制的加椭圆工具
Public RectX1 As Double '新加椭圆（所需的矩形）的点1的X（经纬度）坐标
Public RectY1 As Double '新加椭圆（所需的矩形）的点1的Y（经纬度）坐标
Public RectX2 As Double '新加椭圆（所需的矩形）的点2的X（经纬度）坐标
Public RectY2 As Double '新加椭圆（所需的矩形）的点2的Y（经纬度）坐标
Private Sub Form_Load() '创建定制工具
Map1.CreateCustomTool miAddEllipseTool, _
miToolTypePoint, miCrossCursor
End Sub
  此时所创建的工具没有任何功能，要工具具备相应的功能由第二步实现。
2.2编写工具句柄 (工具具备什么功能)。
  当按下鼠标左键时，需要记下椭圆的起始位置；当鼠标右键弹上时，需要记下椭圆的结束位置，这时，画出椭圆。椭圆将以这两点为矩形的对角线在矩形框中绘制椭圆。需要特别注意的是，MapX4.0中使用的坐标系统是经/纬度系统，而MouseDOwn，MouseUp事件中的坐标是屏幕坐标，因此，需要将屏幕坐标转化为经/纬度坐标，所画椭圆才能显示在正确的位置上。
  关键方法（绘制椭圆）：
OBJECT.CreateEllipticalRegion(Rectangle,[Angle] , [Resolution] , [Style] )
OBJECT:FeatureFactory对象；
Rectangle（矩形）：Rectangle对象，确定了椭圆的大小；
Angle（角度）：变量，决定椭圆绕中心点旋转的角度；
Resolution（精度） ：变量， 椭圆的精度，由多少点构成；
Style（样式）: 变量，定义了所画椭圆的样式，如颜，线型等。
实际编码：
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton And (Map1.CurrentTool = miAddEllipseTool) Then
　Map1.NumericCoordSys.Set miLongLat, 0
　'将屏幕坐标转变为经纬度坐标
　Map1.ConvertCoord X, Y, RectX1, RectY1, miScreenToMap
　End if
End Sub
Private Sub Map1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
　If Button = vbLeftButton And (Map1.CurrentTool = miAddEllipseTool) Then
  '将地图的坐标系统设为经/纬度坐标
  Map1.NumericCoordSys.Set miLongLat, 0
  '将屏幕坐标转变为经纬度坐标
  Map1.ConvertCoord X, Y, RectX2, RectY2, miScreenToMap
  '鼠标弹起时，画椭圆
  Call AddEllipse(form1,RectX1,RectY1,RectX2,RectY2)
　Endif
End sub

'画椭圆过程
Public Sub AddEllipse(frm As Form, x1 As Double, _
y1 As Double,x2 As Double,y2 As Double, EditLayer As Variant)
　Dim RECT As New MapXLib.Rectangle '画椭圆的矩形框
　Dim CreatedEllipse As Feature '所画的椭圆
　Dim I as integer,EditLayer as integer
　'设置画椭圆的矩形框
　RECT.Set x1, y1, x2, y2
　With frm.Map1
  '创建椭圆
  Set CreatedEllipse = .FeatureFactory. _
  CreateEllipticalRegion(RECT, , 500, .DefaultStyle)
  '确定哪一层是可编辑层，椭圆只能画在可编辑层上
  For I=1 to .unt
  　If .map1.layers(I).editable=true then
    Editlayer=I
    Exit for
  　Endif
  Next I
  '将椭圆添加到所画的图层上
  .Layers.Item(EditLayer).AddFeature CreatedEllipse
　End With
End Sub
  此时，画椭圆工具具备了画椭圆的功能，运用定制的这个工具由第三步实现。
  2.3调用定制工具
  '设置当前工具为定制的画椭圆工具
  Map1.CurrentTool=miAddEllipse
  或 Map1.currenttool=1
  3. 结束语
  本例画椭圆时，从鼠标按下，一直到鼠标最后弹起时才可以看到椭圆出现在地图上，这就是说在鼠标移动（MouseMove事件）时，从鼠标按下，到鼠标弹起的中间过程是看不到中间过程的椭圆出现的。为了实现在鼠标移动时，也可以看到椭圆，那么需要在MouseMove事件中画椭圆，并且，每次画椭圆时删除掉前一次画的椭圆。这样的运行结果就是看到，从鼠标按下，到鼠标弹起的过程中，随鼠标的移动而有了绘椭圆的变化过程。
  另外，本文是以VB5为例，进行的编程，但对于其它语言，如VC++，Delphi等，编程思路和关键方法都是相同的。
上个月去天津做这个项目，加班加点忙乎过了十一，现在项目终于完成了第一阶段，可以闲下来总结一下了。
  在做这个项目之前我只是自学了一个月的supermap，不过感觉gis这些东西都是大同小异，没什莫可怕；关键比较郁闷的是本来根本就是做，现在却要用vb实在太。。。算了，，不会也得会呀！
    其实本人对这个实在只能称得上一知半解，学的和用的一样多，不过还是给自己和别人留下点东西吧，也许会有帮助呢：）
    1，设置地图标题（Map1.Title）样式
    在打开一个GeoSet时，会自动显示它的标题，如果你的GeoSet没有标题，它会自动添加一个标题。
    你可以设置标题的样式，显示出最完美的地图
    Map1.Title.Visible = False’是否可见
    Map1.Title.Editable = False'是否可编辑
    标题位置
    Map1.Title.x = Map1.MapScreenWidth - 50
    Map1.Title.y = 2
  是否有边界
    Map1.Title.Border = False
    是否粗体
  Map1.Title.TextStyle.TextFont.Bold = True
    字体大小
    Map1.Title.TextStyle.TextFont.Size = 15
  是否在文本周围绘制光晕
    Map1.Title.TextStyle.TextFontHalo = True
  控制文本是否显示背景
    Map1.Title.TextStyle.TextFontOpaque = False
  是否在文本下绘制阴影
    Map1.Title.TextStyle.TextFontShadow = True
2 打开地图的两种方法
  a,打开地图集
    Map1.GeoSet =”C:\aa.gst” 
    在地图集里，你可以给地图加颜，加标注，限制标注的字体，颜等。这些只能保存
到地图集，而不能保存到单一的图层里。所以建议你把图层做成地图集，这样无论是打开还是显示都很方便。
  b,打开图层
    For i = 1 To UBound(Navigation_DefaultMap_Path)
      Map2.Layers.Add Navigation_DefaultMap_Path(i), i
    Next
3添加数据集
  mapx的地图和数据是分开的，你要想制作专题图，查看表的内容，取图元的数据，都要先添加数据集。
 a,添加图层数据集
  Set lyr = curMap.Layers(layerList.Text)
    curMap.DataSets.Add miDataSetLayer, lyr, lyr.Name
 b,添加自定义数据集
  以下函数是添加一个数据集，sqlstr 是sql语句，DsName是数据集的名称。注意： "orderno", 是我在数据库中取的数据集与地图图元的关联。
  Private Function AddJDDs(sqlstr As String, DsName As String) As Boolean
Dim IsRight As Boolean
IsRight = False
'----------------------添加数据集
On Error GoTo ThemedCreate
'------------是否存在该数据集
 Dim ds As MapXLib.Dataset
 
For Each ds In Map1.DataSets
 If ds.Name = DsName Then
 Map1.DataSets.Remove (DsName) '删除数据集mousemove是什么键
 Exit For
 End If
 Next
 Set ds = Nothing
 '------------------加载数据集----------------------------
  Dim Cn As New ADODB.Connection
 Dim Cmd As New ADODB.Command
 Dim rs As New ADODB.Recordset
Dim BindLyr As New BindLayer
Cn.CursorLocation = adUseClient
Cn.Open ConStr
Set Cmd.ActiveConnection = Cn
 Cmd.CommandText = sqlstr
 rs.Open Cmd, , adOpenKeyset, adLockOptimistic
    BindLyr.LayerType = miBindLayerTypeNormal
If rs.RecordCount <> 0 Then
Map1.DataSets.Add miDataSetADO, rs, DsName, "orderno", , BindLyr
IsRight = True
Else
 MsgBox "无法显示数据,请检查数据是否为空?"
 IsRight = False
End If
rs.Close
Set rs = Nothing
 Cn.Close
 Set Cn = Nothing
  Set Cmd = Nothing
  Set BindLyr = Nothing
AddJDDs = IsRight
 Exit Function
 '-------------------------------------------------------------------
ThemedCreate:
    MsgBox "加载数据集出错！ 请检查数据是否正确?" & Err.Description
    IsRight = False
    AddJDDs = IsRight
End Function

4关闭地图
  a,关闭图层
    Dim lyr As MapXLib.Layer
    Dim i As Integer
   
    For i = 0 To List1.ListCount - 1
        If (List1.Selected(i) = True) Then
            Set lyr = fMainForm.Map1.Layers(List1.List(i))
            lyr.DataSets.RemoveAll
   
            fMainForm.Map1.Layers.Remove lyr
        End If
    Next i
    Set lyr = Nothing
  b,全部关闭
    Map1.GeoSet = ""

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。