⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form05.frm

📁 给出了详细的vb环境下mo基本功能的代码 如图层的加载
💻 FRM
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form05 
   Caption         =   "世界地图"
   ClientHeight    =   7545
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10125
   LinkTopic       =   "Form1"
   ScaleHeight     =   7545
   ScaleWidth      =   10125
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command1 
      Caption         =   "c1"
      Height          =   495
      Left            =   4680
      TabIndex        =   1
      Top             =   6960
      Width           =   1215
   End
   Begin MapObjects2.Map Map1 
      Height          =   5895
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   10095
      _Version        =   131072
      _ExtentX        =   17806
      _ExtentY        =   10398
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Form05.frx":0000
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   855
      Left            =   720
      TabIndex        =   2
      Top             =   6000
      Width           =   8775
   End
End
Attribute VB_Name = "Form05"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xuewei,2003/6/12
'Transform方法示例;

Option Explicit
Dim theShape As Object
Dim transShape As Object
Dim recs As New MapObjects2.Recordset
Dim extentStr As String
Dim sym As New MapObjects2.Symbol
Dim newsym As New MapObjects2.Symbol

Private Sub Command1_Click()
  If Not theShape Is Nothing Then
    Dim toCS As New MapObjects2.ProjCoordSys
    toCS.Type = 54021
    Set transShape = toCS.Transform(Map1.Layers(0).CoordinateSystem, theShape)
    Map1.Refresh
  End If
End Sub

Private Sub Form_Load()
  DrawLayer   '加载世界地图的Country图层;
  Dim CSMap As New MapObjects2.ProjCoordSys
  CSMap.Type = 54019  'World_Winkel-Ⅱ
  
  Map1.Layers(0).CoordinateSystem = CSMap
  Map1.CoordinateSystem = Map1.Layers(0).CoordinateSystem
 
  With sym
    .SymbolType = moFillSymbol
    .Color = moDarkGreen
    .Outline = True
  End With
  
  With newsym
    .Outline = True
    .OutlineColor = moRed
    .Size = 1.5
    .Style = moTransparentFill
  End With
  
  Command1.Caption = "Transform"
  extentStr = "Map Extent: " & Map1.Extent.Left & ", " & Map1.Extent.Right & ", " & Map1.Extent.Top & ", " & Map1.Extent.Bottom
  Label1.Caption = extentStr
End Sub

Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As Stdole.OLE_HANDLE)
  If Not theShape Is Nothing Then
    Map1.DrawShape theShape, sym
    Label1.Caption = extentStr & vbNewLine & "Shape1 Extent: " & theShape.Extent.Left & ", " & theShape.Extent.Right & ", " & theShape.Extent.Top & ", " & theShape.Extent.Bottom
  
    If Not transShape Is Nothing Then
      Map1.DrawShape transShape, newsym
      Label1.Caption = Label1.Caption & vbNewLine & "Shape2 Extent: " & transShape.Extent.Left & ", " & transShape.Extent.Right & ", " & transShape.Extent.Top & ", " & transShape.Extent.Bottom
    End If
  End If
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = 1 Then
    Dim usrPt As New MapObjects2.Point
    Set usrPt = Map1.ToMapPoint(x, y)
    Set recs = Map1.Layers(0).SearchShape(usrPt, moPointInPolygon, "")
    
    If recs.Count = 1 Then
      Set theShape = recs.Fields("Shape").Value
      Set transShape = Nothing
      Map1.Refresh
    End If
  
  '右键放大;
  ElseIf Button = 2 Then
    Dim r As New MapObjects2.Rectangle
    Set r = Map1.TrackRectangle
    Map1.Extent = r
  End If
End Sub

Sub DrawLayer()
  Dim dc As New DataConnection
  Dim layer As MapObjects2.MapLayer
 
  dc.Database = App.Path + "\..\" + "World"
  If Not dc.Connect Then
    MsgBox "在指定的文件夹下没找到图层数据文件!"
    End
  End If
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("country")
  layer.Symbol.Color = moLimeGreen
  Map1.Layers.Add layer
End Sub



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -