frmsave.frm

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

      Else                                          '打开成功，则先关闭原工作空间，再打开新的
            For Each DS In FrmSave.SuperWorkspace1.Datasources
                  If Not (DS Is Nothing) Then
                        '添加数据源
                        FrmSave.TreeView1.Nodes.Add "WORKSPACE", tvwChild, DS.Alias, DS.Alias, 8, 9
                        If DS.Datasets.Count = 0 Then
                              MsgBox DS.Name & "数据源中没有数据集!", vbInformation
                        Else
                              '提取数据源信息添加到TreeView
                              nDtCount = DS.Datasets.Count
                              '添加数据集到TreeView1浏览器中
                              For i = 1 To nDtCount
                                    Select Case DS.Datasets.Item(i).Type
                                          Case scdPoint
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 4
                                          Case scdPointZ
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 4
                                          Case scdLine
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 5
                                          Case scdRegion
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 6
                                          Case scdText
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 7
                                          Case scdNetwork
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 10
                                          Case scdGrid
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 14
                                          Case scdImage
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 16
                                          Case scdTIN
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 17
                                          Case scdDEM
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 15
                                          Case scdCAD
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 12
                                          Case scdECW
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 11
                                          Case scdMrSID
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 13
                                          Case Else
                                                FrmSave.TreeView1.Nodes.Add DS.Alias, tvwChild, , DS.Datasets.Item(i).Name, 3
                                    End Select
                              Next i
                              Set FrmSave.TreeView1.SelectedItem = FrmSave.TreeView1.Nodes.Item(3)
                         End If
                  End If
            Next
            '添加地图窗口列表
            Set objMaps = FrmSave.SuperWorkspace1.Maps
            If objMaps Is Nothing Then
                  MsgBox objError.LastErrorMsg, vbInformation
                  
            Else
                  For i = 1 To objMaps.Count
                        FrmSave.lstMaps.AddItem objMaps.Item(i)
                  Next
            End If
      End If
      
      Set objMaps = Nothing
      Set DS = Nothing
End Sub

Private Sub btnCloseWorkspace_Click()
      Dim nRespond As Integer                '用来接受用户在关闭工作空间是否保存的响应
      Dim nDatasourceCount As Integer        '数据源数目,用来处理单个数据源
      Dim i As Integer                       '循环变量
      Dim strDatasourceName As String        '数据源名称
      Dim objDS As soDataSource              '数据源对象变量
      
      '判断工作空间是否有打开的数据源，有则关闭之
      nDatasourceCount = FrmSave.SuperWorkspace1.Datasources.Count
      If nDatasourceCount > 0 Then
            For Each objDS In FrmSave.SuperWorkspace1.Datasources
                  '数据源改变并且以事务方式打开,则要求用户是否存盘
                  If objDS.Modified = True And objDS.Transacted = True Then
                        nRespond = MsgBox("数据源" + objDS.Alias + "已经改变,是否保存改变？", vbYesNo + vbQuestion)
                        If nRespond = vbYes Then    '保存
                              objDS.Commit
                        End If
                  End If
            Next
            SuperMap1.Layers.RemoveAll
            SuperMap1.Refresh
            Set objDS = Nothing
            SuperWorkspace1.Datasources.RemoveAll
      End If
      '重新设置数据列表窗口
      FrmSave.TreeView1.Nodes.Clear
      FrmSave.TreeView1.Nodes.Add , tvwFirst, "WORKSPACE", "工作空间", 1
'      Set FrmSave.TreeView1.SelectedItem = FrmSave.TreeView1.Nodes(1)
      lstMaps.Clear
        
      Set objDS = Nothing
End Sub

Private Sub btnOpenMap_Click()
      '打开TreeView1浏览器中选中的数据集
      If lstMaps.ListCount < 1 Then
            MsgBox "没有保存的地图对象！", vbInformation
            Exit Sub
      End If
      If lstMaps.ListIndex < 0 Then
            MsgBox "请先在地图列表中选择要打开的地图！", vbInformation
            Exit Sub
      End If
      FrmSave.SuperMap1.Layers.RemoveAll
      FrmSave.SuperMap1.OpenMap lstMaps.Text
      SuperMap1.Refresh
      btnSaveAsMap.Enabled = True
      btnSaveMap.Enabled = False
End Sub

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

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

Private Sub Form_Load()

      Dim strAlias As String            '数据源别名
      Dim nEngineType As seEngineType   '数据引擎类型
      Dim strDatasourceName As String   '数据源绝对路径名
      Dim objDataSource As soDataSource '数据源对象,指向打开的数据源
      Dim objDt As soDataset
      Dim i As Integer                  '循环变量
      
      SuperMap1.Connect SuperWorkspace1.Object
      SuperMap1.Appearance = 1
      
      TreeView1.Nodes.Add , tvwFirst, "WORKSPACE", "工作空间", 1
      strAlias = "World"                '原则上别名可以任意给,建议取成和数据源文件主名
      nEngineType = sceSDBPlus              'SuperMap支持多种类型，此处为SDB类型
      strDatasourceName = App.Path & "\..\Data\World\world.sdb"
      
      '打开数据源
      Set objDataSource = SuperWorkspace1.OpenDataSource(strDatasourceName, strAlias, nEngineType, False)
      If objDataSource Is Nothing Then
            MsgBox "打开数据源失败！", vbInformation
            Exit Sub
      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
      If Not (TreeView1.Nodes(1) Is Nothing) Then TreeView1.Nodes(1).Expanded = True
      If Not (TreeView1.Nodes(2) Is Nothing) Then TreeView1.Nodes(2).Expanded = True
      '刷新地图窗口
      SuperMap1.Action = scaNull
      SuperMap1.Refresh
      '释放内存
      Set objDataSource = Nothing
      Set objDt = Nothing
End Sub

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

Private Sub lstMaps_DblClick()
      btnOpenMap_Click
End Sub

Private Sub mnuAddToCurrWin_Click()
      '添加选中的数据集到当前显示窗口
      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
                  btnSaveMap.Enabled = True
                  btnSaveAsMap.Enabled = False
            End If
      End If
      
      Set objDS = Nothing
      Set objDt = Nothing
End Sub

Private Sub mnuNewMapWin_Click()
      '打开选中的数据集到一个新的显示窗口
      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
                  btnSaveMap.Enabled = True
                  btnSaveAsMap.Enabled = False
            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 = FrmSave.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
            btnSaveMap.Enabled = True
            btnSaveAsMap.Enabled = False
      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