form05.frm

给出了详细的vb环境下mo基本功能的代码 如图层的加载

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form05 
   Caption         =   "墨西哥地图"
   ClientHeight    =   4980
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8880
   LinkTopic       =   "Form1"
   ScaleHeight     =   4980
   ScaleWidth      =   8880
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox List1 
      Height          =   1860
      Left            =   6720
      TabIndex        =   4
      Top             =   1560
      Width           =   1815
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   6720
      TabIndex        =   1
      Text            =   "Combo1"
      Top             =   600
      Width           =   1815
   End
   Begin MapObjects2.Map Map1 
      Height          =   4695
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6255
      _Version        =   131072
      _ExtentX        =   11033
      _ExtentY        =   8281
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Form05.frx":0000
   End
   Begin VB.Label Label5 
      Caption         =   "Label5"
      Height          =   255
      Left            =   6720
      TabIndex        =   7
      Top             =   1200
      Width           =   1575
   End
   Begin VB.Label Label4 
      Caption         =   "Label4"
      Height          =   255
      Left            =   6720
      TabIndex        =   6
      Top             =   240
      Width           =   1455
   End
   Begin VB.Label Label3 
      Caption         =   "Label3"
      Height          =   375
      Left            =   6720
      TabIndex        =   5
      Top             =   4560
      Width           =   1935
   End
   Begin VB.Label Label2 
      Caption         =   "Label1"
      Height          =   255
      Left            =   6720
      TabIndex        =   3
      Top             =   4080
      Width           =   2055
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Left            =   6720
      TabIndex        =   2
      Top             =   3600
      Width           =   2055
   End
End
Attribute VB_Name = "Form05"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xue Wei,2003/5/13
'用ListView添加属性窗口；
'用一个Combo控件来区分不同的对象。在Combo中选择一个对象后，这个对象就闪烁，然后显示其属性；
'还可以显示对象类型和位置；

Option Explicit

Private Const SEARCHTOLPIXELS = 3
Dim Loc As New MapObjects2.Point
Dim Recs2() As MapObjects2.Recordset
Dim layerName() As String
Dim layerNum() As Long

'根据点击的坐标选择对象；
Sub Identify(x As Single, y As Single)
  Dim curCount As Long, layerCount As Long, layer_c As Long
  Dim Loc As New MapObjects2.Point
  Dim theTol As Double
  Dim featCount As Long, fCount As Long
  Dim aLayer As Object
  Dim recs As MapObjects2.Recordset
  Dim aName As String, theItem As String
  Dim aField As Object
  Dim xStr As String, yStr As String
  
  '设置参数；
  layer_c = Map1.Layers.Count
  ReDim layerName(layer_c)
  ReDim Recs2(layer_c)
  Screen.MousePointer = 11
  Combo1.Clear
  List1.Clear
  Set Loc = Map1.ToMapPoint(x, y)
  
  '坐标处理；
  If Loc.x > 1000 Or Loc.y > 1000 Then
    xStr = Int(Loc.x): yStr = Int(Loc.y)
  Else
    xStr = Loc.x: yStr = Loc.y
  End If
  xStr = Format(xStr, "0.000")
  yStr = Format(yStr, "0.000")
  Label1.Caption = "x=" + xStr & ",y=" + yStr
  featCount = 0
  layerCount = -1
  
  '设置误差；
  theTol = Map1.ToMapDistance(SEARCHTOLPIXELS * Screen.TwipsPerPixelX)
  
  '选择对象；
  For Each aLayer In Map1.Layers
    If aLayer.Visible And aLayer.LayerType = moMapLayer Then
      Set recs = aLayer.SearchByDistance(Loc, theTol, "")
      layerCount = layerCount + 1
      layerName(layerCount) = aLayer.Name
      Set Recs2(layerCount) = recs
      curCount = -1
      If recs.Count <> 0 Then
        aName = "Featureid"
        For Each aField In recs.Fields
          If aField.Type = moString Then
            aName = aField.Name
            Exit For
          End If
        Next
      End If
      While Not recs.EOF
        ReDim Preserve layerNum(2, featCount + 1)
        curCount = curCount + 1
        layerNum(1, featCount) = layerCount
        layerNum(2, featCount) = curCount
        featCount = featCount + 1
        Select Case aLayer.Name
          Case "States": theItem = recs("NAME").ValueAsString
          Case "Rivers": theItem = recs("NAME").ValueAsString
          Case "Cities": theItem = recs("NAME").ValueAsString
        End Select
        Combo1.AddItem theItem
        recs.MoveNext
      Wend
    End If
  Next aLayer
  
  If featCount = 0 Then
    Label2.Caption = "没有找到任何对象"
  Else
    Label2.Caption = Str(featCount) + "个对象被找到"
  End If
  If featCount > 0 Then
    Combo1.ListIndex = 0
  End If
  Screen.MousePointer = 0
End Sub

'点击后显示属性；
Sub Identify_list()
  Dim curRec As MapObjects2.Recordset
  Dim curIndex As Long, aIndex As Long, aRec As Long, i As Long
  Dim aField As Object
  Dim aName As String
  
  '设置
  curIndex = Combo1.ListIndex
  If IsNull(Combo1.List(aIndex)) Then
    Exit Sub
  End If
  aIndex = layerNum(1, curIndex)
  aRec = layerNum(2, curIndex)
  aName = layerName(aIndex)
  Set curRec = Recs2(aIndex)
  curRec.MoveFirst
  If aRec > 0 Then
    For i = 1 To aRec
      curRec.MoveNext
    Next i
  End If
  
  '闪烁
  Map1.FlashShape curRec("shape").Value, 3
  
  '写属性；
  List1.Clear
  For Each aField In curRec.Fields
    Select Case aField.Type
    Case moString
      List1.AddItem aField.Name + " = " + aField.Value
    Case moPoint
      Label3.Caption = "对象形状:  点"
    Case moLine
      Label3.Caption = "对象形状:  线"
    Case moPolygon
      Label3.Caption = "对象形状:  多边形"
    Case Else
      List1.AddItem aField.Name + " = " + aField.ValueAsString
    End Select
  Next aField
End Sub

Private Sub combo1_Click()
  Identify_list
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  Call Identify(x, y)
End Sub

Sub DrawLayer()
  Dim dc As New DataConnection
  Dim layer As MapLayer
  dc.Database = App.Path + "\..\" + "Mexico"
  If Not dc.Connect Then
    MsgBox "在指定的文件夹下没找到图层数据文件！"
    End
  End If
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("States")
  layer.Symbol.Color = moYellow
  Map1.Layers.Add layer
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("Rivers")
  layer.Symbol.Color = moRed
  Map1.Layers.Add layer
  Map1.Refresh
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("Cities")
  layer.Symbol.Color = moBlue
  Map1.Layers.Add layer
End Sub


Private Sub Form_Load()
  DrawLayer
  Label1.Caption = "点击位置"
  Label2.Caption = "找到信息"
  Label3.Caption = "对象类型"
  Label4.Caption = "对象名称"
  Label5.Caption = "属性"
End Sub