frmmain1.frm

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

      If TreeView1.Nodes.Count <= 1 Then Exit Sub
      If TreeView1.SelectedItem Is Nothing Then Exit Sub
      If TreeView1.SelectedItem.Text = "工作空间" Then Exit Sub
      If TreeView1.SelectedItem.Parent.Text = "工作空间" Then Exit Sub
      
      Dim objDS As soDataSource
      Dim strDtName As String
      Dim strLayerName As String
      
      If MsgBox("这正在删除数据集，此操作不可恢复。继续吗？", vbQuestion + vbYesNo) = vbNo Then Exit Sub
      strDtName = Me.TreeView1.SelectedItem.Text
      strLayerName = strDtName & "@" & Me.TreeView1.SelectedItem.Parent.Text
      '判断数据集是否正在被显示于地图窗口中。
      If Not (SuperMap1.Layers(strLayerName) Is Nothing) Then
            SuperMap1.Layers.RemoveAll
            SuperMap1.Refresh
      End If
      
      Set objDS = SuperWorkspace1.Datasources(1)
      If objDS Is Nothing Then
            MsgBox "错误！", vbInformation
      Else
            '删除数据集成功后，还要删除TreeView中的相应节点
            If objDS.DeleteDataset(strDtName) Then
                  Me.TreeView1.Nodes.Remove Me.TreeView1.SelectedItem.Index
            End If
      End If
      
      Set objDS = Nothing
End Sub

Private Sub btnNewMapWin_Click()
      '新建一个数据集浏览框
      mnuNewMapWin_Click
End Sub

Private Sub btnOverlay_Click()
      '叠加分析，显示叠加分析对话框
      frmOverlay.Show vbModal, Me
End Sub

Private Sub btnPan_Click()
      If SuperMap1.Layers.Count = 0 Then Exit Sub
      SuperMap1.Action = scaPan
End Sub

Private Sub btnViewEntire_Click()
      If SuperMap1.Layers.Count = 0 Then Exit Sub
      SuperMap1.ViewEntire
End Sub

Private Sub btnZoomFree_Click()
      If SuperMap1.Layers.Count = 0 Then Exit Sub
      SuperMap1.Action = scaZoomFree
End Sub

Private Sub Form_Load()

      SuperMap1.Connect SuperWorkspace1.Object
      SuperMap1.Appearance = 1
      
      Dim strAlias As String            '数据源别名
      Dim nEngineType As seEngineType   '数据引擎类型
      Dim strDatasourceName As String   '数据源绝对路径名
      Dim objDataSource As soDataSource '数据源对象,指向打开的数据源
      Dim objDt As soDataset            '数据集变量
      Dim i As Integer                  '循环变量
  
      TreeView1.Nodes.Add , tvwFirst, "WORKSPACE", "工作空间", 1
      strAlias = "World"                '原则上别名可以任意给,建议取成和数据源文件主名
      nEngineType = sceSDBPlus              'SuperMap支持多种类型，此处为SDB类型
      strDatasourceName = App.Path & "\..\Data\World\world.sdbb"
      
      '打开数据源
      Set objDataSource = SuperWorkspace1.OpenDataSource(strDatasourceName, strAlias, nEngineType, False)
      If objDataSource Is Nothing Then
            MsgBox "打开数据源失败！", vbInformation
      Else
            '添加到TreeView目录树中。
            TreeView1.Nodes.Add "WORKSPACE", tvwChild, SuperWorkspace1.Datasources(1).Alias, SuperWorkspace1.Datasources(1).Alias, 2
            For i = 1 To objDataSource.Datasets.Count
                  Set objDt = objDataSource.Datasets(i)
                  If objDt.Type = scdPoint Then
                        TreeView1.Nodes.Add SuperWorkspace1.Datasources(1).Alias, tvwChild, , objDt.Name, 4
                  ElseIf objDt.Type = scdLine Then
                        TreeView1.Nodes.Add SuperWorkspace1.Datasources(1).Alias, tvwChild, , objDt.Name, 5
                  ElseIf objDt.Type = scdRegion Then
                        TreeView1.Nodes.Add SuperWorkspace1.Datasources(1).Alias, tvwChild, , objDt.Name, 6
                  ElseIf objDt.Type = scdText Then
                        TreeView1.Nodes.Add SuperWorkspace1.Datasources(1).Alias, tvwChild, , objDt.Name, 7
                  Else
                        TreeView1.Nodes.Add SuperWorkspace1.Datasources(1).Alias, tvwChild, , objDt.Name, 3
                  End If
            Next
      End If
      TreeView1.Nodes(1).Expanded = True
      TreeView1.Nodes(2).Expanded = True
      Set TreeView1.SelectedItem = TreeView1.Nodes(1)
      '刷新地图窗口
      SuperMap1.Action = scaNull
      SuperMap1.Refresh
      '释放内存
      Set objDataSource = Nothing
      Set objDt = Nothing
End Sub

Private Sub Form_Resize()
      SuperMap1.Width = Me.ScaleWidth - 2 * SuperMap1.Left
End Sub

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

Private Sub lvwDtAttribute_ItemClick(ByVal Item As MSComctlLib.ListItem)
      If Not (SuperMap1.Layers(lvwDtAttribute.Tag) Is Nothing) Then
            Set SuperMap1.selection.Dataset = SuperMap1.Layers(lvwDtAttribute.Tag).Dataset
            SuperMap1.selection.RemoveAll
            SuperMap1.selection.Add Item.Text
            SuperMap1.Refresh
      End If
End Sub

Private Sub mnuAddToCurrWin_Click()
      '把TreeView1浏览器中选中的数据集添加到当前显示窗口中
      If TreeView1.SelectedItem.Index = 1 Then Exit Sub
      If TreeView1.SelectedItem.Parent.Index = 1 Then Exit Sub
      
      Dim objDS As soDataSource
      Dim objDt As soDataset
      
      Set objDS = SuperWorkspace1.Datasources(TreeView1.SelectedItem.Parent.Text)
      If (objDS Is Nothing) Then
            MsgBox objError.LastErrorMsg, vbInformation
      Else
            Set objDt = objDS.Datasets(TreeView1.SelectedItem.Text)
            If objDt Is Nothing Then
                  MsgBox objError.LastErrorMsg, vbInformation
            Else
                  SuperMap1.Layers.AddDataset objDt, True
                  SuperMap1.Refresh
            End If
      End If
      
      Set objDS = Nothing
      Set objDt = Nothing
End Sub

Private Sub mnuAttributeTable_Click()
      If TreeView1.Nodes.Count <= 1 Then Exit Sub
      If TreeView1.SelectedItem Is Nothing Then Exit Sub
      If TreeView1.SelectedItem.Text = "工作空间" Then Exit Sub
      If TreeView1.SelectedItem.Parent.Text = "工作空间" Then Exit Sub

      Dim objDS As soDataSource                '定义属性浏览的源数据源变量
      Dim objDt As soDataset                   '定义属性浏览的源数据集变量
      Dim objDtVector As soDatasetVector       '定于属性浏览的源矢量数据集变量
      Dim objRecordset As soRecordset          '定义属性浏览的记录变量
      Dim strDtName As String                  '定义属性浏览的数据集名称变量
      Dim i As Integer, j As Integer           '定义循环变量
      Dim vFieldVal As Variant                 '定义字段值接受变量
      Dim iFieldCount As Integer               '定义字段个数变量
            
      strDtName = TreeView1.SelectedItem.Text               'Dataset的名称
      Set objDS = SuperWorkspace1.Datasources(1)
      If objDS Is Nothing Then
            MsgBox objError.LastErrorMsg, vbInformation
            Exit Sub
      Else
            Set objDt = objDS.Datasets(strDtName)
            Set objDS = Nothing
            If objDt Is Nothing Then
                  MsgBox objError.LastErrorMsg
                  Exit Sub
            End If
      End If
            
      
      If objDt.Vector = True Then
            Set objDtVector = objDt
            Set objDt = Nothing
            iFieldCount = objDtVector.FieldCount
      Else
            MsgBox "数据集" & strDtName & "是栅格类数据集，没有属性表！", vbInformation
            Set objDS = Nothing
            Set objDt = Nothing
            Exit Sub
      End If
      
      Set objRecordset = objDtVector.Query("", True)
      If objRecordset Is Nothing Then
            MsgBox objError.LastErrorMsg
            Exit Sub
      Else
            
            lvwDtAttribute.Tag = objDtVector.Name & "@" & objDtVector.DataSourceAlias
            Set objDtVector = Nothing
            lvwDtAttribute.ColumnHeaders.Clear
            lvwDtAttribute.ListItems.Clear
            '添加表头
            For i = 1 To iFieldCount
                  lvwDtAttribute.ColumnHeaders.Add , , objRecordset.GetFieldInfo(i).Name, 800
            Next
            '初始化进度条
            ProgressBar1.Min = 0
            ProgressBar1.Max = objRecordset.RecordCount * objRecordset.FieldCount
            ProgressBar1.Visible = True
            objRecordset.MoveFirst
            '添加属性数据
            For i = 1 To objRecordset.RecordCount
                  lvwDtAttribute.ListItems.Add , , objRecordset.GetFieldValue(1)
                  For j = 2 To iFieldCount
                        vFieldVal = objRecordset.GetFieldValue(j)
                        If (vFieldVal <> vbNull) Then
                              lvwDtAttribute.ListItems(i).SubItems(j - 1) = vFieldVal
                        End If
                  Next
                  ProgressBar1.Value = i * iFieldCount   '进度条同步显示数据装载进度
                  objRecordset.MoveNext                  '装载下一条记录
            Next
            ProgressBar1.Visible = False
      End If
      Set objRecordset = Nothing
End Sub

Private Sub mnuNewMapWin_Click()
      '为TreeView1浏览器中选中的数据集创建一个新的显示窗口
      If TreeView1.SelectedItem.Index = 1 Then Exit Sub
      If TreeView1.SelectedItem.Parent.Index = 1 Then Exit Sub
      
      Dim objDS As soDataSource
      Dim objDt As soDataset
      
      SuperMap1.Layers.RemoveAll
      Set objDS = SuperWorkspace1.Datasources(TreeView1.SelectedItem.Parent.Text)
      If (objDS Is Nothing) Then
            MsgBox objError.LastErrorMsg, vbInformation
      Else
            Set objDt = objDS.Datasets(TreeView1.SelectedItem.Text)
            If objDt Is Nothing Then
                  MsgBox objError.LastErrorMsg, vbInformation
            Else
                  SuperMap1.Layers.AddDataset objDt, True
                  SuperMap1.Refresh
            End If
      End If
      
      Set objDS = Nothing
      Set objDt = Nothing
End Sub

Private Sub TreeView1_DblClick()
     '添加数据集到当前地图浏览框中
      Dim bReload As Boolean
      Dim objLayer As soLayer
      Dim objDt As soDataset
      
      If TreeView1.Nodes.Count <= 1 Then Exit Sub
      If TreeView1.SelectedItem.Text = "工作空间" Then Exit Sub
      If TreeView1.SelectedItem.Parent.Text = "工作空间" Then Exit Sub
      
      bReload = False
      '获取添加的数据集
      Set objLayer = SuperMap1.Layers(TreeView1.SelectedItem.Text & "@" & Trim(TreeView1.SelectedItem.Parent.Text))
      If objLayer Is Nothing Then
            Set objDt = FrmMain.SuperWorkspace1.Datasources(TreeView1.SelectedItem.Parent.Text).Datasets(TreeView1.SelectedItem.Text)
            If objDt Is Nothing Then
                  MsgBox objError.LastErrorMsg, vbInformation
                  Exit Sub
            End If
            SuperMap1.Layers.AddDataset objDt, True
            SuperMap1.Refresh
      End If
      '释放内存
      Set objLayer = Nothing
      Set objDt = Nothing
End Sub

Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
      '右键单击显示弹出对话框
      If Button = vbRightButton Then
            If TreeView1.SelectedItem.Index = 1 Then Exit Sub
            If TreeView1.SelectedItem.Parent.Index = 1 Then Exit Sub
            PopupMenu mnuPopup
      End If
End Sub