www.pudn.com > 12136.rar > Form05.frm

VERSION 5.00 
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx" 
Begin VB.Form Form05  
   Caption         =   "墨西哥地图" 
   ClientHeight    =   4665 
   ClientLeft      =   60 
   ClientTop       =   345 
   ClientWidth     =   6765 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   4665 
   ScaleWidth      =   6765 
   StartUpPosition =   3  '窗口缺省 
   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        =   "Form05.frx":0000 
   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/13 
'删除特征示例； 
 
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("CITIES1") 
  Layer.Symbol.Color = moRed 
  Map1.Layers.Add Layer 
   
  'MsgBox "数据连接成功", vbInformation, "MO示例" 
  Exit Sub 
   
Err1: 
  If dc.ConnectError = 0 Then 
    MsgBox "没找到图层", vbInformation, "MO示例" 
  Else 
    MsgBox ConnectErrorMsg(dc.ConnectError), vbInformation, "MO示例" 
  End If 
  End 
End Sub 
 
Private Sub Form_Load() 
  DrawLayer   '加载墨西哥地图的States和Cities图层； 
End Sub 
 
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
  Dim P1 As MapObjects2.Point 
  Const D1 = 0.3 
  Dim Recset As MapObjects2.Recordset 
  Dim Ans As Variant 
   
  Set P1 = Map1.ToMapPoint(X, Y) 
  '距离查找； 
  Set Recset = Map1.Layers(0).SearchByDistance(P1, D1, "") 
  If Not Recset.EOF Then 
    Map1.FlashShape Recset.Fields("shape").Value, 3 
    Ans = MsgBox("要删除这个特征?", vbYesNo, "MO示例") 
    If Ans = vbYes Then 
      If Recset.Updatable Then 
        Recset.Edit 
        Recset.Delete 
        Recset.MoveNext 
        Recset.StopEditing 
        Map1.Refresh 
      Else 
        MsgBox "记录集不可修改。" 
      End If 
    End If 
  Else 
    MsgBox "没有点击特征。" 
  End If 
End Sub