frmmain.frm

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

VERSION 5.00
Object = "{A6985C02-94B5-4D89-A1FE-C2FFD60BB633}#5.1#0"; "SuperTopo.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.1#0"; "SuperMap.ocx"
Object = "{A61255F7-0A20-431C-86CE-78C14314BE9E}#5.1#0"; "SuperWkspManager.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "带条件的拓扑处理"
   ClientHeight    =   6465
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9585
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6465
   ScaleWidth      =   9585
   StartUpPosition =   2  'CenterScreen
   Begin SuperWkspManagerLib.SuperWkspManager SuperWkspManager1 
      Height          =   5835
      Left            =   30
      TabIndex        =   11
      Top             =   555
      Width           =   2175
      _Version        =   327681
      _ExtentX        =   3836
      _ExtentY        =   10292
      _StockProps     =   0
      DataTab         =   1
      MapTab          =   1
      LayoutTab       =   1
      SenceTab        =   1
      ResourceTab     =   1
   End
   Begin VB.CommandButton cmdSelect 
      Caption         =   "选择"
      Height          =   480
      Left            =   45
      TabIndex        =   8
      Top             =   15
      Width           =   1020
   End
   Begin VB.CommandButton cmdZoomIn 
      Caption         =   "放大"
      Height          =   480
      Left            =   1106
      TabIndex        =   7
      Top             =   15
      Width           =   1020
   End
   Begin VB.CommandButton cmdZoomOut 
      Caption         =   "缩小"
      Height          =   480
      Left            =   2167
      TabIndex        =   6
      Top             =   15
      Width           =   1020
   End
   Begin VB.CommandButton cmdZoomFree 
      Caption         =   "自由缩放"
      Height          =   480
      Left            =   3228
      TabIndex        =   5
      Top             =   15
      Width           =   1020
   End
   Begin VB.CommandButton cmdPan 
      Caption         =   "漫游"
      Height          =   480
      Left            =   4289
      TabIndex        =   4
      Top             =   15
      Width           =   1020
   End
   Begin VB.CommandButton cmdViewEnt 
      Caption         =   "全幅"
      Height          =   480
      Left            =   5340
      TabIndex        =   3
      Top             =   15
      Width           =   1020
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   480
      Left            =   8535
      TabIndex        =   2
      Top             =   15
      Width           =   1020
   End
   Begin VB.CommandButton cmdViewMap 
      Caption         =   "显示数据集"
      Enabled         =   0   'False
      Height          =   480
      Left            =   6375
      TabIndex        =   1
      Top             =   15
      Width           =   1080
   End
   Begin VB.CommandButton cmdTopBuild 
      Caption         =   "构建拓扑"
      Enabled         =   0   'False
      Height          =   480
      Left            =   7472
      TabIndex        =   0
      Top             =   15
      Width           =   1020
   End
   Begin VB.Frame Frame1 
      Height          =   6000
      Left            =   2280
      TabIndex        =   9
      Top             =   465
      Width           =   7305
      Begin SuperTopoLib.SuperTopo SuperTopo 
         Left            =   120
         Top             =   4155
         _Version        =   327681
         _ExtentX        =   847
         _ExtentY        =   847
         _StockProps     =   0
      End
      Begin SuperMapLib.SuperMap SuperMap 
         Height          =   5850
         Left            =   30
         TabIndex        =   10
         Top             =   120
         Width           =   7230
         _Version        =   327681
         _ExtentX        =   12753
         _ExtentY        =   10319
         _StockProps     =   160
         Appearance      =   1
      End
      Begin SuperMapLib.SuperWorkspace SuperWorkspace 
         Left            =   450
         Top             =   525
         _Version        =   327681
         _ExtentX        =   847
         _ExtentY        =   847
         _StockProps     =   0
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'============================SuperMap Objects 示范程序说明=================================
'1.程序说明：示范如何指定打断条件构建拓扑；
'2.使用数据说明：打开Data目录下的World\World.sdb；
'3.操作说明：
'   (1)打开数据源；
'   (2)在数据集列表中选择线数据集，点击“构建拓扑”，在弹出的对话框中，设置要进行的拓扑选项，
'      这里值得注意的是在“高级设置”中的打断设置，可以指定一个点数据集，并设置过滤条件，在
'      拓扑处理的时候，程序会在满足过滤条件的点位置上作打断处理。
'==========================================================================================

Option Explicit

Public strDs As String
Public strDt As String

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdPan_Click()
    SuperMap.Action = scaPan
End Sub

Private Sub cmdSelect_Click()
    SuperMap.Action = scaSelect
End Sub

Private Sub cmdTopBuild_Click() '拓扑处理，显示拓扑对话框
    frmTopo.Show vbModal, Me
End Sub

Private Sub cmdViewEnt_Click()
    SuperMap.ViewEntire
End Sub

Private Sub cmdViewMap_Click()
    '显示选择的数据集
    Dim objDs As soDataSource
    Dim objDt As soDataset
    
    '获取数据源
    Set objDs = SuperWorkspace.Datasources(strDs)
    If objDs Is Nothing Then Exit Sub
    '获取要显示的数据集
    Set objDt = objDs.Datasets(strDt)
    If objDt Is Nothing Then
        MsgBox "错误！", vbInformation
    Else
        '重新显示SuperMap1中的数据集对象
        SuperMap.Layers.RemoveAll
        SuperMap.Layers.AddDataset objDt, True
        SuperMap.ViewEntire
    End If
    SuperMap.SetFocus
    Set objDt = Nothing
    Set objDs = Nothing
End Sub

Private Sub cmdZoomFree_Click()
    SuperMap.Action = scaZoomFree
End Sub

Private Sub cmdZoomIn_Click()
    SuperMap.Action = scaZoomIn
End Sub

Private Sub cmdZoomOut_Click()
    SuperMap.Action = scaZoomOut
End Sub

Private Sub Form_Load()
      SuperMap.Connect SuperWorkspace.Handle
      SuperWkspManager1.Connect SuperWorkspace.Handle
      
      Dim objDs As soDataSource
      Dim i As Integer
      
      Set objDs = SuperWorkspace.OpenDataSource(App.Path & "\..\data\world\world.sdb", "SampleData", sceSDBPlus, False)
      If objDs Is Nothing Then Exit Sub
      SuperWkspManager1.Refresh
      
      Set objDs = Nothing
End Sub

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

Private Sub SuperWkspManager1_LClick(ByVal nFlag As SuperMapLib.seSelectedItemFlag, ByVal strSelected As String, ByVal strParent As String)
    If nFlag = scsDatasource Then
        cmdViewMap.Enabled = False
    Else
        cmdViewMap.Enabled = True
        
        Dim objDs As soDataSource
        Dim objDt As soDataset
        
        Set objDs = SuperWorkspace.Datasources.Item(strParent)
        strDs = strParent
        If objDs Is Nothing Then Exit Sub
        Set objDt = objDs.Datasets.Item(strSelected)
        strDt = strSelected
        If objDt Is Nothing Then Exit Sub
        
        If objDt.Type = scdLine Then
            cmdTopBuild.Enabled = True
        Else
            cmdTopBuild.Enabled = False
        End If
    End If
End Sub

Private Sub SuperWkspManager1_LDbClick(ByVal nFlag As SuperMapLib.seSelectedItemFlag, ByVal strSelected As String, ByVal strParent As String)
    cmdViewMap_Click
End Sub