form1.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{257830F1-B11E-4360-A3B9-E2E9D72A50E3}#3.2#0"; "SuperMap.ocx"
Object = "{2047BF4D-FAC2-4609-99C2-9887873C2438}#3.2#0"; "SuperGridView.ocx"
Begin VB.Form Form1 
   Caption         =   "浏览属性测试"
   ClientHeight    =   6660
   ClientLeft      =   60
   ClientTop       =   420
   ClientWidth     =   8835
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6660
   ScaleWidth      =   8835
   StartUpPosition =   2  'CenterScreen
   Begin VB.CheckBox Check1 
      Caption         =   "过滤系统字段"
      Height          =   345
      Left            =   6930
      TabIndex        =   13
      Top             =   3300
      Width           =   1635
   End
   Begin VB.ComboBox CmbDatasource 
      Height          =   315
      Left            =   6840
      TabIndex        =   10
      Text            =   "Combo1"
      Top             =   840
      Width           =   1935
   End
   Begin VB.ListBox LstDataset 
      Height          =   1425
      Left            =   6840
      TabIndex        =   9
      Top             =   1560
      Width           =   1935
   End
   Begin SuperGridViewLib.SuperGridView SuperGridView1 
      Height          =   2655
      Left            =   60
      TabIndex        =   8
      Top             =   3960
      Width           =   8715
      _Version        =   196610
      _ExtentX        =   15372
      _ExtentY        =   4683
      _StockProps     =   0
   End
   Begin VB.CommandButton btnSelect 
      Caption         =   "选择"
      Height          =   375
      Left            =   165
      TabIndex        =   7
      Top             =   60
      Width           =   1200
   End
   Begin VB.CommandButton btnViewEntire 
      Caption         =   "全幅"
      Height          =   375
      Left            =   6165
      TabIndex        =   6
      Top             =   60
      Width           =   1200
   End
   Begin VB.CommandButton btnZoomFree 
      Caption         =   "自由缩放"
      Height          =   375
      Left            =   4965
      TabIndex        =   5
      Top             =   60
      Width           =   1200
   End
   Begin VB.CommandButton btnZoomOut 
      Caption         =   "缩小"
      Height          =   375
      Left            =   3765
      TabIndex        =   4
      Top             =   60
      Width           =   1200
   End
   Begin VB.CommandButton btnZoomIn 
      Caption         =   "放大"
      Height          =   375
      Left            =   2565
      TabIndex        =   3
      Top             =   60
      Width           =   1200
   End
   Begin VB.CommandButton btnPan 
      Caption         =   "漫游"
      Height          =   375
      Left            =   1365
      TabIndex        =   2
      Top             =   60
      Width           =   1200
   End
   Begin VB.CommandButton btnClose 
      Caption         =   "关闭"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   7365
      TabIndex        =   0
      Top             =   60
      Width           =   1200
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   4800
      Top             =   600
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   5520
      Top             =   600
      _Version        =   196610
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   3420
      Left            =   0
      TabIndex        =   1
      Top             =   480
      Width           =   6795
      _Version        =   196610
      _ExtentX        =   11986
      _ExtentY        =   6032
      _StockProps     =   160
      Appearance      =   1
   End
   Begin VB.Label Label2 
      Caption         =   "数据集"
      Height          =   255
      Left            =   6840
      TabIndex        =   12
      Top             =   1320
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "数据源"
      Height          =   255
      Left            =   6840
      TabIndex        =   11
      Top             =   600
      Width           =   1815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'================================SuperMap Objects示范工程说明=================================
'
'功能简介：
'        1、示范在SuperMap Objects中如何浏览选定图层的属性
'
'所用控件：SuperMap Objects的SuperMap控件、SuperWorkspace控件、SuperGridView控件
'所用数据：上一级目录\..\Data下的World.sdb和World.sdd两个文件
'操作说明：
'        1、使用"选择"、"放大"、"缩小"、"漫游"和"全幅"按钮，可以对地图进行基本操作
'        2、在listView中选定一个数据集，显示为supermap图层,如果该图层为矢量图层，则同时显示其属性数据在SuperGridview控件中
'        3、单击“选择”按钮后单击鼠标选中地图上的对象，则被选中的记录的属性在Listview中被自动高亮选中；反之，如果双击_
'           ListView中的某行记录，则对应的几何对象在地图上呈高亮居中显示。
'        4、选中“过滤系统字段”，则ListView控件中的系统字段会被过滤显示，否则不被过滤。
'===============================SuperMap Objects 示范工程说明结束===============================

Dim objDt As soDatasetVector
Dim objRecordsetSelection As soRecordset

Private Sub btnClose_Click()
      Unload Me
End Sub

Private Sub btnPan_Click()
      SuperMap1.Action = scaPan             '漫游
End Sub

Private Sub btnSelect_Click()
      SuperMap1.Action = scaSelect          '选择
End Sub

Private Sub btnViewEntire_Click()
      SuperMap1.ViewEntire                  '全幅显示
End Sub

Private Sub btnZoomFree_Click()
      SuperMap1.Action = scaZoomFree        '自由缩放
End Sub

Private Sub btnZoomIn_Click()
      SuperMap1.Action = scaZoomIn          '放大
End Sub

Private Sub btnZoomOut_Click()
      SuperMap1.Action = scaZoomOut         '缩小
End Sub

Private Sub CmdBrowse_Click()
      Dim objRecordset As soRecordset
      Dim objDataset As soDatasetVector
      
      If SuperMap1.Layers.Count < 1 Then Exit Sub
      If SuperMap1.Layers(1).Dataset.Vector = False Then
            MsgBox "非矢量图层无属性记录集！", vbInformation
            Exit Sub
      End If
      Set objDataset = SuperMap1.Layers(1).Dataset
      Set objDt = SuperMap1.Layers(1).Dataset
      If objDataset Is Nothing Then Exit Sub
      Set objRecordset = objDataset.Query("", False)
      SuperGridView1.Connect objRecordset
      
      Set objRecordset = Nothing
      Set objDataset = Nothing
End Sub

Private Sub Check1_Click()
      SuperGridView1.SysFieldVisible = IIf((Check1.Value = 0), True, False)
End Sub

Private Sub Form_Load()
      Dim strAlias As String            '数据源别名
      Dim nEngineType As seEngineType   '数据引擎类型
      Dim strDataSourceName As String   '数据源绝对路径名
      Dim objDataSource As soDataSource '数据源对象,指向打开的数据源
      Dim objlayer As soLayer           '图层对象变量,指向将要打开的图层
      Dim bAddToHead As Boolean         '是否加到最上面
      Dim i As Integer                  '循环变量
      
      SuperMap1.Connect SuperWorkspace1.Object
      SuperMap1.Appearance = 1
      
      strAlias = "World"                '原则上别名可以任意给,建议取成和数据源文件主名
      nEngineType = sceSDB              'SuperMap支持多种类型，此处为SDB类型
      strDataSourceName = App.Path & "\..\data\world.sdb"                       'CommonDialog1.FileName
      
      '打开数据源
      Set objDataSource = SuperWorkspace1.OpenDataSource(strDataSourceName, strAlias, nEngineType, True)
      If objDataSource Is Nothing Then
            MsgBox "打开数据源失败！", vbInformation
      Else
            '把数据源别名加到数据源列表中
            CmbDatasource.AddItem objDataSource.Alias
            CmbDatasource.ListIndex = 0
      End If
      '把数据源中的所有数据集加入到数据集列表中
      For i = 1 To objDataSource.Datasets.Count
            LstDataset.AddItem objDataSource.Datasets(i).Name
      Next
      LstDataset.ListIndex = 0
           
      '释放内存
      Set objDataSource = Nothing
      Set objlayer = Nothing
      
End Sub

Private Sub Form_Unload(Cancel As Integer)
      Set objDt = Nothing
      Set objRecordsetSelection = Nothing
      
      SuperGridView1.Disconnect
      SuperMap1.Disconnect
      SuperMap1.Close
      SuperWorkspace1.Close
End Sub

Private Sub LstDataset_Click()
      Dim objDataset As soDataset
      Dim objRecordset As soRecordset
      
      If LstDataset.ListCount < 1 Then Exit Sub
      If LstDataset.SelCount < 1 Then Exit Sub
      SuperMap1.Layers.RemoveAll
      
      Set objDataset = SuperWorkspace1.Datasources(1).Datasets(LstDataset.Text)
      If objDataset Is Nothing Then Exit Sub
      SuperMap1.Layers.AddDataset objDataset, True
      SuperMap1.Refresh
      
      If objDataset.Vector Then
            Set objDt = objDataset
            Set objRecordset = objDt.Query("", False)
            If Not (objRecordset Is Nothing) Then
                  SuperGridView1.SysFieldVisible = IIf((Check1.Value = 0), True, False)
                  Me.SuperGridView1.Connect objRecordset
            End If
      End If
      
      Set objDataset = Nothing
      Set objRecordset = Nothing
End Sub

Private Sub SuperGridView1_ItemDbClick(ByVal nObjID As Long)
      Dim strFilter As String
      
      If (objDt.Name <> SuperMap1.Layers(1).Dataset.Name) Then Exit Sub
      strFilter = "SmID = " & Str(nObjID)
      Set objRecordsetSelection = objDt.Query(strFilter, True)
      SuperMap1.selection.FromRecordset objRecordsetSelection
      SuperMap1.EnsureVisibleRecordset objRecordsetSelection, 2
      SuperMap1.Refresh
End Sub

Private Sub SuperMap1_GeometrySelected(ByVal nSelectedGeometryCount As Long)
      Dim lObjectId As Long
      
      If nSelectedGeometryCount < 1 Then Exit Sub
      Set objRecordsetSelection = SuperMap1.selection.ToRecordset(False)
      If Not (objRecordsetSelection Is Nothing) Then
            lObjectId = objRecordsetSelection.GetID
            SuperGridView1.SeekID lObjectId
      End If
End Sub