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

📄 form1.frm

📁 MO组件开发的图层加载功能
💻 FRM
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "Mo20.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5415
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8295
   LinkTopic       =   "Form1"
   ScaleHeight     =   5415
   ScaleWidth      =   8295
   StartUpPosition =   3  '窗口缺省
   Begin VB.CheckBox Check4 
      Caption         =   "城市名称"
      Height          =   495
      Left            =   120
      TabIndex        =   10
      Top             =   2520
      Value           =   1  'Checked
      Width           =   1215
   End
   Begin VB.CheckBox Check3 
      Caption         =   "州界"
      Height          =   495
      Left            =   120
      TabIndex        =   9
      Top             =   1920
      Value           =   1  'Checked
      Width           =   1215
   End
   Begin VB.CheckBox Check2 
      Caption         =   "河流"
      Height          =   495
      Left            =   120
      TabIndex        =   8
      Top             =   1320
      Value           =   1  'Checked
      Width           =   1215
   End
   Begin VB.CheckBox Check1 
      Caption         =   "城市"
      Height          =   495
      Left            =   120
      TabIndex        =   7
      Top             =   720
      Value           =   1  'Checked
      Width           =   1215
   End
   Begin VB.CommandButton Command6 
      Caption         =   "显示地图"
      Height          =   495
      Left            =   6720
      TabIndex        =   6
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton Command5 
      Caption         =   "隐藏地图"
      Height          =   495
      Left            =   5400
      TabIndex        =   5
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton Command4 
      Caption         =   "图层0可见"
      Height          =   495
      Left            =   4080
      TabIndex        =   4
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "图层0不可见"
      Height          =   495
      Left            =   2760
      TabIndex        =   3
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "图层卸载"
      Height          =   495
      Left            =   1440
      TabIndex        =   2
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "图层加载"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   4560
      Width           =   1215
   End
   Begin MapObjects2.Map Map1 
      Height          =   4095
      Left            =   1800
      TabIndex        =   0
      Top             =   240
      Width           =   5415
      _Version        =   131072
      _ExtentX        =   9551
      _ExtentY        =   7223
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Form1.frx":0000
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim dc As New DataConnection
Dim layer As New MapLayer

Private Sub Check1_Click()
Set layer = Map1.Layers(0)
If Check1.Value = 0 Then
layer.Visible = False
Else
layer.Visible = True
End If
Map1.Refresh
End Sub

Private Sub Check2_Click()
Set layer = Map1.Layers(1)
If Check2.Value = 0 Then
layer.Visible = False
Else
layer.Visible = True
End If
Map1.Refresh
End Sub


Private Sub Check3_Click()
Set layer = Map1.Layers(2)
If Check3.Value = 0 Then
  layer.Visible = False
Else
layer.Visible = True
End If
Map1.Refresh
End Sub

Private Sub Check4_Click()
Set layer = Map1.Layers(0)
Set layer.Renderer = New LabelRenderer
If Check4.Value = 0 Then
 layer.Renderer.AllowDuplicates = False
Else
Call layer0render(layer)
End If
Map1.Refresh
End Sub


Private Sub Command1_Click()
layerset
Map1.Refresh
End Sub

Private Sub Command2_Click()
Map1.Layers.Clear
End Sub

Private Sub Command3_Click()
On Error GoTo err1
Set layer = Map1.Layers("Rivers")
layer.Visible = False
Map1.refesh
Exit Sub

err1:
MsgBox "没有图层"
End Sub

Private Sub Command4_Click()
On Error GoTo err1
Set layer = Map1.Layers("Rivers")
layer.Visible = True
Map1.Refresh
Exit Sub
err1:
    MsgBox "没有图层"
End Sub

Private Sub Command5_Click()
Map1.Visible = False
End Sub

Private Sub Command6_Click()
Map1.Visible = True
End Sub
Private Sub layer0render(layer1 As MapLayer)
Set layer1.Renderer = New LabelPlacer
layer1.Renderer.Field = "NAME"
layer1.Renderer.Symbol(0).Font.Name = "Times New Roman"
layer1.Renderer.Symbol(0).Font.Bold = False
layer1.Renderer.Symbol(0).Color = moBlack
layer1.Renderer.Symbol(0).Font.Size = 8
layer1.Renderer.AllowDuplicates = True
End Sub
Private Sub layerset()

Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("States")
layer.Symbol.Color = moYellow
layer.Symbol.Size = 1
layer.Symbol.Style = 2
layer.Symbol.OutlineColor = moBrown
Map1.Layers.Add layer

Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("Rivers")
layer.Symbol.Color = moBlue
layer.Symbol.Size = 2
Map1.Layers.Add layer

Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("Cities")
layer.Symbol.Color = moRed
layer.Symbol.Style = 2
layer.Symbol.Size = 4

Map1.Layers.Add layer

End Sub

Private Sub Form_Load()
dc.Database = App.Path
If Not dc.Connect Then
MsgBox "在指定的文件夹没有找到图层数据文件"
End
End If


Map1.Refresh

End Sub

⌨️ 快捷键说明

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