MapX應(yīng)用講義第04章 MapX程序設(shè)計(jì)

1、第4章 MapX程序設(shè)計(jì)884.1 MapX概述884.2 MapX安裝884.3 MapX程序設(shè)計(jì)894.3.1 【文件】選單894.3.2 【編輯】選單954.3.3 【對(duì)象編輯】選單984.3.4 【地圖】選單1044.3.5 【查詢】選單1094.3.6 【緊縮表】選單1104.3.8 【選項(xiàng)】選單1164.3.9 【窗口】選單1174.3.10 繪震中分布圖1194.3.11 工具條設(shè)計(jì)1224.4 MapX自定義事件1234.4.1 AddFeatureToolUsed事件1234.4.2 AnnotationAdded事件1244.4.3 AnnotationChanged事件1

2、244.4.4 DataMismatch事件1254.4.5 DrawUserLayer事件1254.4.6 MapDraw事件1264.4.7 MapInitialized事件1264.4.8 MapViewChanged事件1274.4.9 MouseWhell事件1274.4.10 PolyToolUsedEvent事件1274.4.11 RequestData事件1284.4.12 ResolveDataBind事件1294.4.13 ResolveDataBindEx事件1304.4.14 SelectionChanged事件1304.4.15 ThemeModifyRequeste

3、d事件1314.4.16 ToolUsed事件131第4章 MapX程序設(shè)計(jì)本章主要以實(shí)例講述MapX開發(fā)，以實(shí)現(xiàn)MapInfo主選單中的大部分功能，另外還講述了MapX的自定義事件。4.1 MapX概述MapX是Mapinfo 公司開發(fā)的能向用戶提供強(qiáng)大地圖分析功能的ActiveX控件產(chǎn)品。由于它是一種基于Windows 操作系統(tǒng)的標(biāo)準(zhǔn)控件，因而MapX能支持絕大多數(shù)標(biāo)準(zhǔn)的可視化開發(fā)環(huán)境，如： Visual Basic，Visual C+ ，Delphi，PowerBuilder等。利用MapX，用戶能夠簡(jiǎn)單而快速地在自己的企業(yè)應(yīng)用中嵌入地圖化功能，增強(qiáng)企業(yè)應(yīng)用的空間分析能力，實(shí)現(xiàn)企業(yè)應(yīng)用的

4、增值。由于采用的是控件技術(shù)，因此應(yīng)用程序可以脫離Mapinfo的軟件平臺(tái)運(yùn)行。4.2 MapX安裝MapX的安裝非常簡(jiǎn)單，可以將其安裝到Windows(Windows95/98、 Windows XP或WindowsNT4.0或更高版本)上。其安裝步驟如下：(1)運(yùn)行MapX光盤中的Setup.exe程序，出現(xiàn)歡迎畫面。單擊【Next(下一步)】繼續(xù)安裝。(2)出現(xiàn)軟件許可協(xié)議屏。選擇“是Yes”以接受協(xié)議的條款并繼續(xù)安裝。(3)顯示選擇安裝MapX的目錄屏。指定安裝目錄后，單擊【Next(下一步)】繼續(xù)安裝。(4)選擇要安裝的產(chǎn)品組件。(5)單擊【Next(下一步)】按鈕繼續(xù)安裝，稍后，便可

5、安裝完畢。安裝MapX后，將MapX 的OCX控件注冊(cè)到用戶計(jì)算機(jī)中，并提供一系列用戶在開發(fā)過程中非常有用的工具和資料，包括MapX開發(fā)指南、MapX參考手冊(cè)、MapX 聯(lián)機(jī)幫助文檔、示例程序、示例數(shù)據(jù)、MapInfo地圖和Geoset工具等。安裝注冊(cè)到用戶機(jī)器中的OCX控件實(shí)際上是向用戶提供了一個(gè)Map 對(duì)象，它具有多種屬性和方法，如圖4-1所示。圖4-1 MapX 控件的屬性和方法4.3 MapX程序設(shè)計(jì)MapInfo的大部分功能可通過MapX程序設(shè)計(jì)直接或間接實(shí)現(xiàn)，下面用實(shí)例來實(shí)現(xiàn)MapInfo的功能，介紹MapX的程序設(shè)計(jì)。實(shí)例程序主界面如圖4-2所示：圖4-2 MapX程序?qū)嵗绦蛑?/p>

6、界面4.3.1 【文件】選單【文件】選單如圖4-3所示。圖4-3 【文件】選單1. 【新建表】命令MapX 4.0不能新建Tab表，MapX 4.5以后的版本可以創(chuàng)建Tab表。主要程序如下：Private Sub CommandCreate_Click() Dim I As Integer, LayerName As String, StrName As String, StrType As String Dim LayerInfo As New MapXLib.LayerInfo, flds As New MapXLib.Fields Dim NumWidth As Integer, Num

7、Dec As Integer, TmpNum As Integer, TmpStr As Integer Dim DirFile As String On Error Resume Next CM1.DialogTitle = "保存表文件" CM1.DefaultExt = "表文件|*.tab" CM1.Filter = "表(*.tab)|*.tab" CM1.CancelError = True CM1.Action = 2 If Err.Number = 32755 Then Exit Sub FileSpec = CM1.

8、FileName LayerName = CM1.FileTitle I = InStr(LayerName, ".") If (I > 0) Then LayerName = Left(LayerName, I - 1) End If DirFile = Dir(FileSpec) If (DirFile <> "") Then I = InStr(FileSpec, ".") DirFile = Left(FileSpec, I - 1) + "*" Kill DirFile End If F

9、or I = 1 To Grid1.Rows - 1 Grid1.Row = I Grid1.Col = 0 StrName = Grid1.Text Grid1.Col = 1 StrType = Grid1.Text If InStr(StrType, "") > 0 Then TmpNum = InStr(StrType, "") TmpStr = Mid(StrType, TmpNum + 1, Len(StrType) - TmpNum - 1) NumWidth = Val(TmpStr) If InStr(TmpStr, "

10、,") > 0 Then NumWidth = Val(Left(TmpStr, InStr(TmpStr, ",") - 1) NumDec = Val(Right(TmpStr, Len(TmpStr) - InStr(TmpStr, ",") End If End If If InStr(StrType, "字符型") > 0 Then flds.AddStringField StrName, NumWidth ElseIf InStr(StrType, "整型") Then flds.

11、AddIntegerField StrName ElseIf InStr(StrType, "短整型") Then flds.AddSmallIntField StrName ElseIf InStr(StrType, "浮點(diǎn)型") Then flds.AddFloatField StrName ElseIf InStr(StrType, "十進(jìn)制型") Then flds.AddNumericField StrName, NumWidth, NumDec ElseIf InStr(StrType, "日期型")

12、Then flds.AddDateField StrName ElseIf InStr(StrType, "邏輯型") Then flds.AddLogicalField StrName End If Next I LayerInfo.Type = 7 'miLayerInfoTypeNewTab LayerInfo.AddParameter "FileSpec", FileSpec LayerInfo.AddParameter "Name", LayerName LayerInfo.AddParameter "Fi

13、elds", flds '將新建圖層加入到數(shù)據(jù)集 LayerInfo.AddParameter "AutoCreateDataset", 1 LayerInfo.AddParameter "DataSetName", LayerName frmD.Map1.Layers.Add LayerInfo, 1 '若要為新表創(chuàng)建投影，則先要設(shè)置Map1.NumericCoorsys. ''''Set ActiveForm.Map1.NumericCoordSys = ActiveForm.Map1.Dis

14、playCoordSys ''''activeform.Map1.MapUnit = activeform.Map1.NumericCoordSys.Units ChangeCombo Unload MeEnd Sub2. 【打開表】命令MapX可以打開并顯示MapInfo的Tab表、點(diǎn)陣圖像文件*.tif與*.shp文件，主要程序如下所示：Private Sub OpenTable_Click() Dim FileName As String, filepath As String, LayerName As String Dim lyr As MapXLib

15、.Layer Dim LayerInfo As New MapXLib.LayerInfo Dim FilterIndex As Integer Dim csys As New MapXLib.CoordSys On Error Resume Next CM1.DialogTitle = "打開文件" CM1.DefaultExt = "Tab|*.tab" CM1.Filter = "表(*.tab)|*.Tab|GeoTiff File(*.Tif)|*.Tif|ShapeFile(*.tab)|*.Tab|ServerLayer(Spat

16、ialWare)" CM1.CancelError = True CM1.Action = 1 If Err.Number = 32755 Then Exit Sub FileName = CM1.FileTitle filepath = CM1.FileName filepath = Left(filepath, InStr(filepath, FileName) - 1) LayerName = Left(FileName, InStr(FileName, ".") - 1) FilterIndex = CM1.FilterIndex Select Case

17、FilterIndex Case 1: '*.tab LayerInfo.Type = miLayerInfoTypeTab LayerInfo.AddParameter "FileSpec", filepath + FileName Case 2: 'You must use Geotiff file. 'GeoTiff and Tiff:GeoTiff is a raster TIFF file that has stored the geographical coordinates 'of where it belongs on the

18、 earth. A TIFF is a regular raster file that need to be registered in Mi Pro. LayerInfo.Type = miLayerInfoTypeRaster LayerInfo.AddParameter "FileSpec", filepath + FileName LayerInfo.AddParameter "Name", LayerName Case 3: '*.shp - Failed 'csys.PickCoordSys csys.Set 1, 0 &#

19、39;Set activeform.Map1.DisplayCoordSys = csys 'Set activeform.Map1.NumericCoordSys = csys 'activeform.Map1.NumericCoordSys.PickCoordSys 'activeform.Map1.DisplayCoordSys.PickCoordSys 'activeform.Map1.DisplayCoordSys.PickCoordSys LayerInfo.Type = miLayerInfoTypeShape LayerInfo.AddParam

20、eter "FileSpec", filepath + FileName LayerInfo.AddParameter "CoordSys", csys End Select '將新建圖層加入到數(shù)據(jù)集 LayerInfo.AddParameter "AutoCreateDataset", 1 LayerInfo.AddParameter "DataSetName", LayerName Set lyr = ActiveForm.Map1.Layers.Add(LayerInfo, 1) Set Active

21、Form.Map1.NumericCoordSys = ActiveForm.Map1.DisplayCoordSys 'activeform.Map1.MapUnit = activeform.Map1.NumericCoordSys.Units ChangeComboEnd Sub3. 【打開地圖集】命令MapX不能打開MapInfo的*.Wor工作空間，只能打開*.Gst地圖集，此處的地圖集相當(dāng)于MapInfo的工作空間。Private Sub OpenGeoset_Click() Dim filepath As String, FileName As String Dim La

22、yerInfo As New MapXLib.LayerInfo, lyr As MapXLib.Layer Dim ds As MapXLib.Dataset On Error Resume Next CM1.DialogTitle = "打開文件" CM1.DefaultExt = "gst" CM1.Filter = "GeoSet(*.gst)|*.gst" CM1.CancelError = True CM1.Action = 1 If Err.Number = 32755 Then Exit Sub ActiveForm.

23、Map1.Geoset = CM1.FileName For Each ds In frmD.Map1.Datasets Set lyr = frmD.Map1.Layers(LyrName) frmD.Map1.Datasets.Add miDataSetLayer, lyr, ds.Name Next Set ds = Nothing Set lyr = Nothing Set ActiveForm.Map1.NumericCoordSys = ActiveForm.Map1.DisplayCoordSys 'activeform.Map1.MapUnit = activeform

24、.Map1.NumericCoordSys.Units ChangeComboEnd Sub4. 【打開缺省地圖集】命令Private Sub LoadStartUpWor() Dim TheWorFile As String On Error Resume Next TheWorFile = App.Path + "StartUp.gst" ActiveForm.Map1.Geoset = TheWorFile For Each ds In frmD.Map1.Datasets Set lyr = frmD.Map1.Layers(LyrName) frmD.Map1.D

25、atasets.Add miDataSetLayer, lyr, Next Set ds = Nothing Set lyr = Nothing Set ActiveForm.Map1.NumericCoordSys = ActiveForm.Map1.DisplayCoordSys ChangeComboEnd Sub5. 【關(guān)閉表】命令Private Sub CommandOK_Click() Dim lyr As MapXLib.Layer Dim I As Integer For I = 0 To List1.ListCount - 1 If (List1.Select

26、ed(I) = True) Then Set lyr = frmD.Map1.Layers(List1.List(I) lyr.Datasets.RemoveAll frmD.Map1.Layers.Remove lyr End If Next I ChangeCombo Set lyr = Nothing Unload MeEnd Sub6. 【全部關(guān)閉】命令Private Sub CloseGeoset_Click() ActiveForm.Map1.Geoset = ""End Sub7. 【保存地圖集】命令Private Sub SaveGeoset_Click()

27、 Dim filepath As String Dim FileName As String 'On Error Resume Next CM1.DialogTitle = "保存地圖集" CM1.DefaultExt = "gst" CM1.Filter = "GeoSet(*.gst)|*.gst" CM1.CancelError = True CM1.Flags = &H2 CM1.Action = 2 If Err.Number = 32755 Then Exit Sub FileName = CM1.File

28、Title filepath = CM1.FileName FileName = Left(FileName, InStr(FileName, ".") - 1) ActiveForm.Map1.SaveMapAsGeoset FileName, filepath End Sub8. 【保存為缺省地圖集】命令Private Sub SaveGeostDefault_Click() ActiveForm.Map1.SaveMapAsGeoset "StartUp", TheInstallPath + "StartUp.gst"End S

29、ub9. 【存儲(chǔ)為圖像文件】命令Private Sub mnuSavePicture_Click() Dim lyr As MapXLib.Layer TheOutFile = App.Path + "" + ActiveForm.Map1.Layers.Item(1).name + ".BMP" FrmSaveMap.Show 1 If (bOKCancel = True) Then ActiveForm.Map1.PaperUnit = miPaperUnitPoint ActiveForm.Map1.ExportMap TheOutFile, Ex

30、portFormat, PaperWidth, PaperHeight End IfEnd Sub4.3.2 【編輯】選單【編輯】選單如圖4-4所示。圖4-4 【編輯】選單1. 【剪切】命令Private Sub mnuEditCut_Click() Dim FtrFac As New MapXLib.FeatureFactory Dim lyr As MapXLib.Layer, I As Integer For Each lyr In ActiveForm.Map1.Layers If lyr.Selection.Count > 0 Then Set CopyFtrs = lyr.N

31、oFeatures CopyFtrs.Add lyr.Selection.Clone End If Next For I = 1 To EditLayer.Selection.Count '用于擦出的目標(biāo) Set Feature1 = EditLayer.Selection.Item(I) EditLayer.DeleteFeature Feature1 Next I Set Feature1 = NothingEnd Sub2. 【拷貝】命令Private Sub copy_Click() Dim lyr As MapXLib.Layer For Each lyr In Active

32、Form.Map1.Layers If lyr.Selection.Count > 0 Then Set CopyFtrs = lyr.NoFeatures CopyFtrs.Add lyr.Selection.Clone End If NextEnd Sub3. 【粘貼】命令Private Sub paste_Click() Dim lyr As MapXLib.Layer Dim ftr As New MapXLib.Feature Set lyr = ActiveForm.Map1.Layers(EditLayer) For Each ftr In CopyFtrs lyr.Add

33、Feature ftr Next '注意:若要將屬性數(shù)據(jù)一起拷貝過來，則必須加入rowvalues參數(shù)End Sub4. 【清除】命令Private Sub mnuEditDelete_Click() Dim I As Integer For I = 1 To EditLayer.Selection.Count '用于擦出的目標(biāo) Set Feature1 = EditLayer.Selection.Item(I) EditLayer.DeleteFeature Feature1 Next I Set Feature1 = Nothing If (BrowserLayer <

34、;> "") Then FrmBrowser.Grid1.RemoveItem FrmBrowser.Grid1.Row End IfEnd Sub5. 【整形】命令Private Sub mnuEditReShape_Click() ActiveForm.Map1.Layers.Item(EditLayerName).ShowNodes = TrueEnd Sub6. 【新建行】命令Private Sub mnuEditAddRow_Click() Dim I As Long, FeatureKey As Long If (BrowserLayer <>

35、 "") Then FrmBrowser.Grid1.Row = FrmBrowser.Grid1.Rows - 1 FrmBrowser.Grid1.Col = FrmBrowser.Grid1.Cols - 1 'FeatureKey FeatureKey = Val(FrmBrowser.Grid1.Text) I = FrmBrowser.Grid1.Rows - 1 FrmBrowser.Grid1.AddItem "", I + 1 FrmBrowser.Grid1.Row = I + 1 FrmBrowser.Grid1.Col =

36、 FrmBrowser.Grid1.Cols - 1 FrmBrowser.Grid1.Text = Format(FeatureKey + 1), "#0") FrmBrowser.Grid1.Col = 0 End IfEnd Sub7. 【獲取信息】命令Private Sub mnuEditF7_Click() Dim MiType As Integer Dim lyr As MapXLib.Layer For Each lyr In ActiveForm.Map1.Layers If lyr.Selection.Count = 1 Then Set Feature1

37、 = lyr.Selection.Item(1) Exit For End If Next MiType = Feature1.Type Select Case MiType Case 0 'miFeatureTypeRegion Case 1 'miFeatureTypeLine Case 2 'miFeatureTypeSymbol FrmAnnoSymbol.Show Case 3 'miFeatureTypeMixed Case 4 'miFeatureTypeUnknown Case 5 'miFeatureTypeText FrmAn

38、noText.Show Case 6 'miFeatureTypeNull Case 7 'miSymbolAnnotation End SelectEnd Sub4.3.3 【對(duì)象編輯】選單【對(duì)象編輯】選單如圖4-5所示。圖4-5 【對(duì)象編輯】選單1. 【設(shè)置目標(biāo)】命令Private Sub EditFeatureSetSource_Click() Set Feature1 = EditLayer.Selection.Item(1)End Sub2. 【清除目標(biāo)】命令Private Sub EditFeatureClearSource_Click() Set Feature1

39、 = NothingEnd Sub3. 【對(duì)象合并】命令Private Sub EditFeatureConbine_Click() Dim FtrFac As New MapXLib.FeatureFactory '用于合并的第2個(gè)目標(biāo) Set Feature2 = EditLayer.Selection.Item(1) Set FtrFac = ActiveForm.Map1.FeatureFactory '合并目標(biāo) Set FeatureN = FtrFac.CombineFeatures(Feature1, Feature2) Set FeatureN.Style =

40、Feature1.Style EditLayer.AddFeature FeatureN '刪除用于合并的目標(biāo) EditLayer.DeleteFeature Feature1 EditLayer.DeleteFeature Feature2 Set Feature1 = Nothing Set Feature2 = Nothing Set FeatureN = NothingEnd Sub4. 【對(duì)象分割】命令Private Sub EditFeatureCut_Click() Dim FtrFac As New MapXLib.FeatureFactory '用于分割的目標(biāo)

41、 Set Feature2 = EditLayer.Selection.Item(1) Set FtrFac = ActiveForm.Map1.FeatureFactory '擦出相交目標(biāo) Set FeatureN = FtrFac.EraseFeature(Feature1, Feature2) Set FeatureN.Style = Feature1.Style EditLayer.AddFeature FeatureN '擦除源目標(biāo)外部 Set FeatureN = FtrFac.IntersectFeatures(Feature1, Feature2) Set Fe

42、atureN.Style = Feature1.Style EditLayer.AddFeature FeatureN '刪除擦出前的目標(biāo) EditLayer.DeleteFeature Feature1 Set Feature1 = Nothing Set Feature2 = Nothing Set FeatureN = NothingEnd Sub5. 【對(duì)象擦除】命令Private Sub EditFeatureErase_Click() Dim FtrFac As New MapXLib.FeatureFactory '用于擦除的目標(biāo) Set Feature2 = E

43、ditLayer.Selection.Item(1) Set FtrFac = ActiveForm.Map1.FeatureFactory '擦除目標(biāo) Set FeatureN = FtrFac.EraseFeature(Feature1, Feature2) Set FeatureN.Style = Feature1.Style EditLayer.AddFeature FeatureN '刪除擦除前的目標(biāo) EditLayer.DeleteFeature Feature1 Set Feature1 = Nothing Set Feature2 = Nothing Set F

44、eatureN = NothingEnd Sub6. 【對(duì)象擦除外部】命令Private Sub EditFeatureEraseOut_Click() Dim FtrFac As New MapXLib.FeatureFactory '用于擦除的目標(biāo) Set Feature2 = EditLayer.Selection.Item(1) Set FtrFac = ActiveForm.Map1.FeatureFactory '擦除源目標(biāo)外部 Set FeatureN = FtrFac.IntersectFeatures(Feature1, Feature2) Set Featu

45、reN.Style = Feature1.Style EditLayer.AddFeature FeatureN '刪除擦差前的目標(biāo) EditLayer.DeleteFeature Feature1 Set Feature1 = Nothing Set Feature2 = Nothing Set FeatureN = NothingEnd Sub7. 【緩沖區(qū)】命令Private Sub EditFeatureBuffeer_Click() FrmBuffer.Show 1 If (bOKCancel = True) Then Dim FtrFac As New MapXLib.Fe

46、atureFactory '緩沖區(qū)目標(biāo) Set Feature1 = EditLayer.Selection.Item(1) Set FtrFac = ActiveForm.Map1.FeatureFactory '擦除相交目標(biāo) Set FeatureN = FtrFac.BufferFeatures(Feature1, BufferDistance, BufferUnits, BufferResolution) 'Set FeatureN.Style = Feature1.Style EditLayer.AddFeature FeatureN 'Set Fea

47、tureN = Nothing End IfEnd Sub8. 【平滑】命令Private Sub EditFeatureSmooth_Click() Dim ftr As MapXLib.Feature For Each ftr In EditLayer.Selection ftr.Smooth = True ftr.Update NextEnd Sub9. 【撤消平滑】命令Private Sub EditFeatureUnSmooth_Click() Dim ftr As MapXLib.Feature For Each ftr In EditLayer.Selection ftr.Smo

48、oth = False ftr.Update NextEnd Sub10. 【轉(zhuǎn)換為區(qū)域】命令Private Sub EditFeatureRegion_Click() Dim I As Integer, J As Integer, iNodeCnt As Integer Dim arrVals As Variant Dim Source As MapXLib.Feature, ftr As MapXLib.Feature Dim FtrFac As MapXLib.FeatureFactory Dim NodesLBound As Integer, NodesUBound As Intege

49、r Dim X() As Double, Y() As Double, N As Integer Dim Pnt As New Point, Pnts As New points Dim bDelete As Boolean bDelete = False Set Source = ActiveForm.Map1.Layers(EditLayer).Selection(1) arrVals = Source.Nodes NodesLBound = LBound(arrVals, 1) NodesUBound = UBound(arrVals, 1) PolysLBound = LBound(a

50、rrVals, 2) PolysUBound = UBound(arrVals, 2) For I = PolysLBound To PolysUBound iNodeCnt = arrVals(NodesLBound, I) * 2 N = Fix(iNodeCnt - (NodesLBound + 1) / 2) + 1 ReDim X(1 To N), Y(1 To N) N = 0 For J = NodesLBound + 1 To iNodeCnt Step 2 N = N + 1 X(N) = arrVals(J, I) Y(N) = arrVals(J + 1, I) Next J If (Abs(X(N) - X(1) + Abs(Y(N) - Y(1) > 0.001) Then For J = 1 To N Pnt.Set X(J), Y(J) Pnts.Add Pnt, J Next J Pnt.Set X