📄 form03.frm
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form03
Caption = "墨西哥地图"
ClientHeight = 5415
ClientLeft = 60
ClientTop = 345
ClientWidth = 6765
LinkTopic = "Form1"
ScaleHeight = 5415
ScaleWidth = 6765
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 2640
TabIndex = 1
Top = 4800
Width = 1215
End
Begin MapObjects2.Map Map1
Height = 4575
Left = 0
TabIndex = 0
Top = 0
Width = 6735
_Version = 131072
_ExtentX = 11880
_ExtentY = 8070
_StockProps = 225
BackColor = 16777215
BorderStyle = 1
Contents = "Form03.frx":0000
End
End
Attribute VB_Name = "Form03"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xuewei,2003/6/10
'使用ACCESS数据库向属性数据库写数据;
Option Explicit
Private Sub DrawLayer()
Dim layer As MapLayer
Dim dc As New DataConnection
On Error GoTo Err1
dc.Database = App.Path + "\..\" + "Mexico"
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("states")
layer.Symbol.Color = moLimeGreen
Map1.Layers.Add layer
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("CITIES")
layer.Symbol.Color = moRed
Map1.Layers.Add layer
Exit Sub
Err1:
If dc.ConnectError = 0 Then
MsgBox "没找到图层", vbInformation, "MO示例"
Else
MsgBox ConnectErrorMsg(dc.ConnectError), vbInformation, "MO示例"
End If
End
End Sub
'设置ACCESS数据库用,临时;
Private Sub Command2_Click()
Dim Rst1 As ADODB.Recordset
Dim Rst2 As ADODB.Recordset
Dim Ri As Long
Set Rst1 = New ADODB.Recordset
Rst1.Open "select * from cities", Cnn2, adOpenStatic, adLockReadOnly
Set Rst2 = New ADODB.Recordset
Rst2.Open "select * from cities", Cnn2, adOpenDynamic, adLockOptimistic
Ri = Rst1.RecordCount
Do While Not Rst1.EOF
Rst2.AddNew
Rst2!CITIES_ = Rst1!CITIES_
Rst2!POPULATION = Rst1!POPULATION + 1000
Rst2!RYEAR = 2002
Rst2.Update
Rst1.MoveNext
Loop
End Sub
Private Sub Command1_Click()
Dim Recs As MapObjects2.Recordset
Dim layer As MapObjects2.MapLayer
Dim Rst1 As ADODB.Recordset
Dim Str1 As String
On Error GoTo Err1
Str1 = InputBox("输入年度", "MO示例", "2002")
Set Rst1 = New ADODB.Recordset
Rst1.Open "select * from cities where RYEAR = '" & Str1 & "'", Cnn2, adOpenStatic, adLockReadOnly
Set layer = Map1.Layers("cities")
Set Recs = layer.Records
Do While Not Recs.EOF
Recs.Edit
Recs!POPULATION = Rst1!POPULATION
Recs.Update
Recs.MoveNext
Rst1.MoveNext
Loop
Set Recs = Nothing
Set Rst1 = Nothing
MsgBox "修改完成"
Exit Sub
Err1:
MsgBox "输入错误"
End Sub
Private Sub Form_Load()
DrawLayer '加载墨西哥地图的States和Cities图层;
SetAccessDb
Command1.Caption = "写入数据"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -