[VB+MAPX]功能开发的实现代码共享（只允许贴码跟贴）

我先来一段。。。

Private Sub Map1_MapViewChanged()  主要实现比例尺和视野
 Dim ZoomValue As Double
 Dim CoordUnit As Integer
 Dim areunit As Integer
 Dim UnitStr As String
 Dim areunit1 As Integer
 Dim coordunit1 As Integer
 Dim i As Integer
 Dim bilichi As Double
 ZoomValue = GISmain.Map1.zoom
 CoordUnit = GISmain.Map1.MapUnit
 areunit = GISmain.Map1.AreaUnit
 
 
 Map1.MapUnit = 6
 bilichi = (Map1.zoom * 567) / Map1.Width
 Map1.MapUnit = CoordUnit
 
 
 Select Case CoordUnit  以下为单位，粘的时候乱码了。。。
    Case 0
      UnitStr = "英里"
      coordunit1 = 0
    Case 1
      UnitStr = "¹«Àï"
      coordunit1 = 1
    Case 2
      UnitStr = "Ó¢´ç"
      coordunit1 = 2
    Case 3
      UnitStr = "Ó¢³ß"
      coordunit1 = 3
    Case 4
      UnitStr = "Âë"
      coordunit1 = 4
    Case 5
      UnitStr = "ºÁÃ×"
      coordunit1 = 5
    Case 6
      UnitStr = "ÀåÃ×"
      coordunit1 = 6
    Case 7
      UnitStr = "Ã×"
      coordunit1 = 7
    Case 9
      UnitStr = "º£Àï"
      coordunit1 = 8
    Case 13
      UnitStr = "¶È"
      coordunit1 = 9
 End Select
 Select Case areunit
    Case 14
      areunit1 = 0
    Case 15
      areunit1 = 1
    Case 16
      areunit1 = 2
    Case 17
      areunit1 = 3
    Case 18
      areunit1 = 4
    Case 19
      areunit1 = 5
    Case 20
      areunit1 = 6
    Case 21
      areunit1 = 7
    Case 29
      areunit1 = 8
 End Select
    Combo1.Clear
    Combo2.Clear
    Combo3.ListIndex = coordunit1
    Combo4.ListIndex = areunit1
    For i = 1 To GISmain.Map1.Layers.Count
      Combo1.AddItem GISmain.Map1.Layers.Item(i).Name
    Next i
    For i = 1 To GISmain.Map1.DataSets.Count
      Combo2.AddItem GISmain.Map1.DataSets.Item(i).Name
    Next i
    If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
    If Combo2.ListCount > 0 Then Combo2.ListIndex = 0
  StatusBar1.Panels.Item(2).Text = "视野" + Format(str(ZoomValue), "#,##0.000000") + " " + UnitStr
  StatusBar1.Panels.Item(3).Text = 比例尺" + "1:" + Format(str(bilichi), "#,##0.00")
   Map2.Refresh
End Sub

Sub MapX_Ruler(ByRef p As MapXLib.points, rMode As Integer)  主要实现标尺功能
    Dim aLen As Double
    Dim i As Integer
    
    Dim CoordUnit As Integer
    Dim UnitStr As String
    CoordUnit = GISmain.Map1.MapUnit
    Select Case CoordUnit
      Case 0
        UnitStr = "Ó¢Àï"
      Case 1
        UnitStr = "¹«Àï"
      Case 2
        UnitStr = "Ó¢´ç"
      Case 3
        UnitStr = "Ó¢³ß"
      Case 4
        UnitStr = "Âë"
      Case 5
        UnitStr = "ºÁÃ×"
      Case 6
        UnitStr = "ÀåÃ×"
      Case 7
        UnitStr = "Ã×"
      Case 9
        UnitStr = "º£Àï"
      Case 13
        UnitStr = "¶È"
    End Select
  
    If rMode = 2 Then
        'For i = p.Count - 2 To p.Count - 1
        If p.Count >= 2 Then
            i = p.Count - 1
            aLen = aLen + Map1.Distance(p.Item(i).x, p.Item(i).y, p.Item(i + 1).x, p.Item(i + 1).y)
        End If
        'Next i
    ElseIf rMode = 1 Then
        For i = 1 To p.Count - 1
            aLen = aLen + Map1.Distance(p.Item(i).x, p.Item(i).y, p.Item(i + 1).x, p.Item(i + 1).y)
        Next i
    End If
    
    If rMode = 1 Then
        GISmain.Text2.Text = Format$(aLen, "##.####") + UnitStr
        'StatusBar1.Panels(3).Text = "总距离" + Format$(aLen, "##.####") + UnitStr
      
    ElseIf rMode = 2 Then
        GISmain.Text1.Text = Format$(aLen, "##.####") + UnitStr
        GISmain.Text2.Text = " "
        'StatusBar1.Panels(4).Text = "距离" + Format$(aLen, "##.####") + UnitStr
        'StatusBar1.Panels(3).Text = ""
    End If
End Sub

同时在下面自定义工具
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 f As New Feature
    Dim mcount
    Dim pl
    Dim rg As New Feature
    Dim QueryLayer As String
    Dim ftraddpt As Feature
    Dim lyrtemp As Layer
    Dim reg_unit
    Dim reg_area
      
  
    Select Case ToolNum
        Case 107  ‘标尺
            
               Select Case Flags
                Case miPolyToolBegin
                Case miPolyToolEnd

                    f.Attach Map1
                    f.Type = miFeatureTypeLine
                    f.Style.LineStyle = 1
                    f.Style.LineColor = 255
                    f.Style.LineWidth = 1

                    Call MapX_Ruler(points, 1)
                    
                Case miPolyToolEndEscaped
                Case miPolyToolInProgress
                    Call MapX_Ruler(points, 2)
                
                End Select

如何在MapX下读取属性值。
有三种方法：
1． 由Layer对象的KeyField属性来设立要读取属性值的字段名。
接着，由Feature对象的keyValue读取此行的属性值。
2． 将图层加入到Datasets,  由Dataset对象的Value（x,y）属性，通过设置行号，列号来获得属性值。
3． 将图层加入到Datasets,之后由RowValues(ftr)获取整行的值。
        Dim ds As MapXLib.Dataset, lyr As MapXLib.layer
        Dim ftrs As Features
Dim ftr As Feature
Dim rv As RowValue
Dim rvs As RowValues
Dim DsName As String   ‘数据集名
Dim DsRows As Long, DsCols As Long
Dim i As Long, j As Long

    Set ds = Formmain.Map1.Datasets.Item(DsName)
    Set lyr = ds.layer
    
    Set ftrs = lyr.AllFeatures
    
    DsCols = ds.Fields.Count
    DsCols = DsCols + 1
    DsRows = ftrs.Count

    Grid1.Rows = DsRows + 1
    Grid1.Cols = DsCols
    
    Grid1.Row = 0
    For i = 0 To DsCols - 1
      Grid1.Col = i
      Grid1.Text = ds.Fields.Item(i + 1).Name
    Next i
    Grid1.Col = DsCols - 1
    Grid1.Text = "Fkey"

    lyr.BeginAccess miAccessRead
    
    i = 1
    For Each ftr In ftrs
        Set rvs = ds.RowValues(ftr)
        j = 0
        For Each rv In rvs
          If Not IsNull(rv.Value) Then Grid1.TextArray(i * DsCols + j) = Trim(rv.Value)
          j = j + 1
        Next
        Grid1.TextArray(i * DsCols + j) = ftr.FeatureKey
        i = i + 1
    Next
    lyr.EndAccess miAccessEnd    
    Set ftr = Nothing
    Set ftrs = Nothing
    Set ds = Nothing
    Set rv = Nothing
    Set rvs = Nothing
    Set lyr = Nothing
注意：BeginAccess，以及EndAccess可以明显的提高属性读取的速度。

自定义范围专题图
Dim ds As New MapXLib.Dataset
Dim thm As New MapXLib.Theme
Set ds = Formmain.Map1.Datasets(ToolBars.Combo2.Text)
Set thm = ds.Themes.add(0, "aa", "aa", False)
thm.Legend.Compact = False
thm.AutoRecompute = False
'thm.ComputeTheme = False
thm.DataMax = 700
thm.DataMin = 100
thm.ThemeProperties.AllowEmptyRanges = True
thm.ThemeProperties.NumRanges = 7
thm.ThemeProperties.DistMethod = miCustomRanges
thm.ThemeProperties.RangeCategories(1).Max = 150
thm.ThemeProperties.RangeCategories(1).Min = 50
thm.ThemeProperties.RangeCategories(2).Max = 250
thm.ThemeProperties.RangeCategories(2).Min = 150
thm.ThemeProperties.RangeCategories(3).Max = 350
thm.ThemeProperties.RangeCategories(3).Min = 250
thm.ThemeProperties.RangeCategories(4).Max = 450
thm.ThemeProperties.RangeCategories(4).Min = 350
thm.ThemeProperties.RangeCategories(5).Max = 550
thm.ThemeProperties.RangeCategories(5).Min = 450
thm.ThemeProperties.RangeCategories(6).Max = 650
thm.ThemeProperties.RangeCategories(6).Min = 550
thm.ThemeProperties.RangeCategories(7).Max = 750
thm.ThemeProperties.RangeCategories(7).Min = 650
'thm.ComputeTheme = True
thm.AutoRecompute = True
thm.Visible = True

如何实现测距
a.//创建测距工具
     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

SymbolFont.Name与SymbolCharacter
二者皆用来定义Trutype字符集，但最好使用SymbolFont.Name。
Private Sub Command1_Click()

Dim pt As New Point ' Point object passed to the CreateSymbol method of the FFeatureFactory
Dim sty As New Style ' Style object passed to the CreateSymbol method, determines what symboltype/style...etc.

x1 = Map1.CenterX
y1 = Map1.CenterY
pt.Set x1, y1 ' Set the point for where the user clicked...

sty.SymbolFont.Name = "MapInfo Arrows"
sty.SymbolFont.Size = 48 ' set the size of the symbol to be 48...
sty.SymbolFontColor = 255 ' set color of the symbol to be red...
sty.SymbolFontHalo = True ' turn Halo effect on...
sty.SymbolFontBackColor = miColorBlue ' change the Halo color to blue
Set ftr = lyr.AddFeature(FF.CreateSymbol(pt, sty))

End Sub
另一种用来选择字符集的方法：sty.PickSymbol

用miDataSetGlobalHandle来实现数据的绑定


CMapXBindLayer bLayer;
CMapXFields flds;

bLayer.CreateDispatch(bLayer.GetClsid());
flds.CreateDispatch(flds.GetClsid());

//Our source data in the correct tab-delimited form.
//In practice, this could come from a text file or some
//other source.
const char* tabifiedData =
"\"Cust1\"\t\"Loc1\"\t-72.40\t42.22\r\n"
"\"Cust2\"\t\"Loc2\"\t-75.40\t40.48\r\n"
"\"Cust3\"\t\"Loc3\"\t-76.40\t38.02\r\n";

bLayer.SetLayerName("Customer");
bLayer.SetRefColumn1(3);
bLayer.SetRefColumn2(4);
bLayer.SetLayerType(miBindLayerTypeXY);

flds.Add(1, "Customer");
flds.Add(2, "Location");
flds.Add(3, "X");
flds.Add(4, "Y");

//The global handle which will contain the actual data.
HGLOBAL hGlobalData=NULL;
//This temporarily points to the location of the locked
//handle's data

char* pHandleData=NULL;
COleVariant SourceData;

//Allocate space for the handle's data and copy the source
//data into it
hGlobalData = GlobalAlloc(GMEM_MOVEABLE, strlen(tabifiedData)+1);
pHandleData = (char*)GlobalLock(hGlobalData);
strcpy(pHandleData, tabifiedData);
GlobalUnlock(hGlobalData);
pHandleData = NULL;

//Point the SourceData variant at the global handle
SourceData.vt = VT_I4;
SourceData.lVal = (long)hGlobalData;

try {
//Now add the Dataset to the Datasets collection
COleVariant bindVt, fldsVt;
COptionalVariant optVt;

fldsVt.vt = VT_DISPATCH;
fldsVt.pdispVal = flds.m_lpDispatch;

bindVt.vt = VT_DISPATCH;
bindVt.pdispVal = bLayer.m_lpDispatch;

CMapXDataset ds = m_ctrlMapX.GetDatasets().Add(miDataSetGlobalHandle, SourceData, COleVariant("My Dataset"), COleVariant(1l), optVt, bindVt, fldsVt, optVt);

//Create a simple Theme from the data
ds.GetThemes().Add(COptionalVariant(), COptionalVariant(), COptionalVariant());
}
catch (COleDispatchException *e) {
e->ReportError();
e->Delete();
}
catch (COleException *e) {
e->ReportError();
e->Delete();
}

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

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");

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