📄 form1.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 + -