www.pudn.com > 12136.rar > 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