frmmain.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

VERSION 5.00
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Begin VB.Form frmMain 
   Caption         =   "裁剪数据集"
   ClientHeight    =   7005
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9675
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7005
   ScaleWidth      =   9675
   StartUpPosition =   2  'CenterScreen
   Begin SuperMapLib.SuperWorkspace SuperWorkspace 
      Left            =   4020
      Top             =   2400
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin SuperMapLib.SuperMap SuperMap 
      Height          =   2595
      Left            =   60
      TabIndex        =   5
      Top             =   600
      Width           =   2655
      _Version        =   327682
      _ExtentX        =   4683
      _ExtentY        =   4577
      _StockProps     =   160
   End
   Begin VB.CommandButton btnDisplay 
      Caption         =   "显示原图层"
      Height          =   390
      Left            =   5460
      TabIndex        =   4
      Top             =   45
      Width           =   1365
   End
   Begin VB.CommandButton btnHide 
      Caption         =   "隐藏原图层"
      Height          =   390
      Left            =   4110
      TabIndex        =   3
      Top             =   45
      Width           =   1365
   End
   Begin VB.CommandButton btnClipPolygon 
      Caption         =   "多边形裁剪"
      Height          =   390
      Left            =   2760
      TabIndex        =   2
      Top             =   45
      Width           =   1365
   End
   Begin VB.CommandButton btnClipRect 
      Caption         =   "矩形裁剪"
      Height          =   390
      Left            =   1410
      TabIndex        =   1
      Top             =   45
      Width           =   1365
   End
   Begin VB.CommandButton btnClipCircle 
      Caption         =   "圆形裁剪"
      Height          =   390
      Left            =   60
      TabIndex        =   0
      Top             =   45
      Width           =   1365
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'================================SuperMap Objects示范工程说明=================================
'
'功能简介：示范对数据集的裁剪
'所用控件：SuperMap控件、SuperWorkspace控件
'所用数据：..\Data\World目录下的world.sdb和world.sdd两个文件
'操作说明：
'        1、点击"圆形裁剪"或"矩形裁剪"或"多边形裁剪"按钮，在地图窗口中画出相应的圆或矩形或多边形；
'        2、程序自动弹出"裁剪数据集"对话框。进行相应设置后，按"裁剪"按钮进行裁剪。
'        3、成功后，按"隐藏原图层"按钮，可以隐藏原图层，查看裁剪结果。
'
'===============================SuperMap Objects示范工程说明结束===============================
 
Option Explicit

Private Sub btnClipCircle_Click()   '圆形裁剪
    MsgBox "请在地图上画一个圆，进行裁剪！", vbInformation
    SuperMap.Action = scaTrackCircle
End Sub

Private Sub btnClipPolygon_Click()  '多边形裁剪
    MsgBox "请在地图上画一个多边形，进行裁剪！", vbInformation
    SuperMap.Action = scaTrackPolygon
End Sub

Private Sub btnClipRect_Click()     '矩形裁剪
    MsgBox "请在地图上画一个矩形，进行裁剪！", vbInformation
    SuperMap.Action = scaTrackRectangle
End Sub

Private Sub btnDisplay_Click()      '显示原图层
    Dim objLayer As soLayer
    
    Set objLayer = SuperMap.Layers("world@world")
    If Not objLayer Is Nothing Then
        objLayer.Visible = True
        SuperMap.Refresh
    End If
End Sub

Private Sub btnHide_Click()         '隐藏原图层
    Dim objLayer As soLayer
    
    Set objLayer = SuperMap.Layers("World@World")
    If Not objLayer Is Nothing Then
        objLayer.Visible = False
        SuperMap.Refresh
    End If
End Sub

Private Sub Form_Load()
    SuperMap.Connect SuperWorkspace.Handle
    '打开数据源
    SuperWorkspace.OpenDataSource App.Path & "\..\Data\world\world.sdb", "World", sceSDBPlus, False
    '添加数据集到地图窗口
    SuperMap.Layers.AddDataset SuperWorkspace.Datasources(1).Datasets("World"), True
End Sub

Private Sub Form_Resize()
    If (Me.ScaleWidth > 0) Then
        SuperMap.Width = Me.ScaleWidth - 2 * SuperMap.Left
    End If
    If Me.ScaleHeight > 0 Then
        SuperMap.Height = Me.ScaleHeight - SuperMap.Top
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SuperMap.Close
    SuperMap.Disconnect
    SuperWorkspace.Close
End Sub

Private Sub SuperMap_Tracked()      '画完圆、矩形、多边形后，显示"裁剪数据集"对话框
    SuperMap.Action = 0
    
    If SuperMap.Layers.Count > 1 Then
        SuperMap.Layers.RemoveAt 1
    End If
    
    frmClip.Show vbModal, Me
End Sub