frmmain.frm

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

        SuperMap1.Layers.RemoveAll
        SuperMap1.Layers.AddDataset objDt, True
        SuperMap1.ViewEntire
    End If
    
    Set objDS = Nothing
    Set objDt = Nothing
      
End Sub

Private Sub btnSplitObjects_Click()
    '分解复杂对象
    If FrmMain.SuperMap1.selection.Count > 0 Then
        frmObjManipulate.Caption = "分解复杂对象"
        frmObjManipulate.iManipulate = 7
        frmObjManipulate.Show vbModal, FrmMain
    Else
        MsgBox "所选对象不够复杂!", vbInformation
    End If
End Sub

Private Sub btnExit_Click()
    Unload Me
End Sub

Private Sub btnObjXOR_Click()
   '只有面数据集才能异或操作
   If FrmMain.SuperMap1.selection.Count > 1 Then
        If FrmMain.SuperMap1.selection.Dataset.Type = scdRegion Then
            frmObjManipulate.Caption = "对象异或"
            frmObjManipulate.iManipulate = 3
            frmObjManipulate.Show vbModal, FrmMain
        Else
            MsgBox "非面数据集,不能异或!", vbInformation
        End If
    Else
        MsgBox "所选对象数量太少!", vbInformation
    End If
 End Sub

Private Sub btnSelect_Click()
    SuperMap1.Action = scaSelect
End Sub

Private Sub btnPan_Click()
    SuperMap1.Action = scaPan
End Sub

Private Sub btnZoomIn_Click()
    SuperMap1.Action = scaZoomIn
End Sub

Private Sub btnZoomOut_Click()
    SuperMap1.Action = scaZoomOut
End Sub

Private Sub btnZoomFree_Click()
    SuperMap1.Action = scaZoomFree
End Sub

Private Sub btnViewEntire_Click()
    SuperMap1.ViewEntire
End Sub


Private Sub btnObjCopy_Click()
    '复制对象
    If FrmMain.SuperMap1.Visible = True Then
        If FrmMain.SuperMap1.selection.Count > 0 Then
            Select Case FrmMain.SuperMap1.selection.Dataset.Type
                Case scdPoint, scdLine, scdNetwork, scdRegion, scdText
                    frmObjManipulate.Caption = "对象克隆"            '    "对象克隆"
                    frmObjManipulate.iManipulate = 4
                    frmObjManipulate.Show vbModal, FrmMain
                Case Else
                    MsgBox "暂不支持该类型的数据集克隆!", vbInformation
            End Select
        Else
            MsgBox "没有选择对象!", vbInformation
        End If
    End If
End Sub

Private Sub btnCreateBuffer_Click()
   '生成缓冲区
   If FrmMain.SuperMap1.Visible = True Then
        If FrmMain.SuperMap1.selection.Count > 0 Then
            Select Case FrmMain.SuperMap1.selection.Dataset.Type
                Case scdRegion               '面图层可以直接做Buffer
                    frmCreateBuffer.Show vbModal, FrmMain
                Case scdLine, scdPoint, scdNetwork
                    frmCreateBuffer.Show vbModal, FrmMain
            End Select
        End If
    End If
End Sub

Private Sub btnObjUnion_Click()
    '合并
    If FrmMain.SuperMap1.Visible = True Then
        If FrmMain.SuperMap1.selection.Count > 1 Then
            Select Case FrmMain.SuperMap1.selection.Dataset.Type
                Case scdLine, scdRegion, scdText, scdNetwork
                    frmObjManipulate.Caption = "对象相并"             '   "对象相并"
                    frmObjManipulate.iManipulate = 1
                    frmObjManipulate.Show vbModal, FrmMain
                Case Else
                    MsgBox "所选类型对象不能相并", vbInformation
            End Select
        Else
            MsgBox "所选对象数量太少!", vbInformation
        End If
    End If
End Sub

Private Sub btnObjIntersect_Click()
    '相交
    If FrmMain.SuperMap1.Visible = True Then
        If FrmMain.SuperMap1.selection.Count > 1 Then
            Select Case FrmMain.SuperMap1.selection.Dataset.Type
                Case scdLine, scdRegion
                    frmObjManipulate.Caption = "对象相交"
                    frmObjManipulate.iManipulate = 2
                    frmObjManipulate.Show vbModal, FrmMain
                Case Else
                    MsgBox "所选类型对象不能求交!", vbInformation
            End Select
        Else
            MsgBox "所选对象数量太少!", vbInformation
        End If
    End If
End Sub

Private Sub btnLineToRegion_Click()
    '线转换为面
    If FrmMain.SuperMap1.Visible = True Then
        If FrmMain.SuperMap1.selection.Count > 0 Then
            If (FrmMain.SuperMap1.selection.Dataset.Type = scdLine) Or (FrmMain.SuperMap1.selection.Dataset.Type = scdNetwork) Then
                frmObjManipulate.Caption = "类型转换：线 -> 面"
                frmObjManipulate.iManipulate = 5
                frmObjManipulate.Show vbModal, FrmMain
            Else
                MsgBox "所选对象类型不匹配！", vbInformation
                Exit Sub
            End If
        Else
            MsgBox "没有选择对象!", vbInformation
        End If
    End If
End Sub

Private Sub btnRegionToLine_Click()
    '面转换为线
    If FrmMain.SuperMap1.Visible = True Then
        If FrmMain.SuperMap1.selection.Count > 0 Then
            If FrmMain.SuperMap1.selection.Dataset.Type = scdRegion Then
                frmObjManipulate.Caption = "类型转换：面 -> 线"
                frmObjManipulate.iManipulate = 6
                frmObjManipulate.Show vbModal, FrmMain
            Else
                MsgBox "所选对象类型不匹配！", vbInformation
                Exit Sub
            End If
        Else
            MsgBox "没有选择对象!", vbInformation
        End If
    End If
End Sub

Private Sub btnObjDelete_Click()
    '删除所选对象
    If FrmMain.SuperMap1.Visible = True Then
        If FrmMain.SuperMap1.selection.Count > 0 Then
            If MsgBox("此项操作不可恢复，继续吗?", vbQuestion + vbYesNo) = vbYes Then
                Dim objRecordset As soRecordset
                Dim i As Long
                Set objRecordset = FrmMain.SuperMap1.selection.ToRecordset(False)
                If objRecordset Is Nothing Then
                    MsgBox "所选对象的有关数据被损坏，无法继续！", vbCritical
                    Exit Sub
                End If
                objRecordset.MoveFirst
                For i = 1 To objRecordset.RecordCount
                    objRecordset.Delete
                    objRecordset.MoveNext
                Next
                FrmMain.SuperMap1.Refresh
            End If
        End If
    End If
End Sub

Private Sub btnSelectiontoDt_Click()
    '保存为数据集
    If FrmMain.SuperMap1.selection.Count < 1 Then
        MsgBox "没有数据被选中!", vbInformation
    Else
        frmSelectionToDataset.Show vbModal, FrmMain
    End If
End Sub

Private Sub btnDeleteDt_Click()
    '删除数据集
    Dim objDS As soDataSource
    Dim strDtName As String
    
    If tvwData.SelectedItem.Index = 1 Then
        Exit Sub
    Else
        strDtName = tvwData.SelectedItem.Text
    End If
    
    If MsgBox("这将删除实际数据，而且不能恢复，继续吗？", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    If SuperMap1.Layers.Count > 0 Then
        If InStr(SuperMap1.Layers(1).Name, strDtName) <> 0 Then
            If MsgBox("数据集正被显示，删除吗！", vbQuestion + vbYesNo) = vbNo Then
                Exit Sub
            Else
                SuperMap1.Layers.RemoveAll
                SuperMap1.Action = scaNull
                SuperMap1.Refresh
            End If
        End If
    End If
    Set objDS = SuperWorkspace1.Datasources(1)
    If objDS Is Nothing Then Exit Sub
    
    If objDS.DeleteDataset(strDtName) = True Then
        tvwData.Nodes.Remove tvwData.SelectedItem.Index
    Else
        MsgBox "删除失败！", vbInformation
    End If
    
    Set objDS = Nothing
    
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 bReadOnly As Boolean              '数据源里的数据是否只读
    Dim objlayer As soLayer               '图层对象变量,指向将要打开的图层
    Dim bAddToHead As Boolean             '是否加到最上面
    Dim i As Integer                      '循环变量
    
    nEngineType = sceSDBPlus
    strDataSourceName = App.Path & "\..\Data\World\world.sdb"
    strAlias = "World"                    '原则上别名可以任意给,建议取成和数据源文件主名
    bReadOnly = False                     '不设为只读
    
    '打开数据源
    Set objDataSource = SuperWorkspace1.OpenDataSource(strDataSourceName, strAlias, nEngineType, bReadOnly)
    If objDataSource Is Nothing Then
        MsgBox "打开数据源失败！", vbInformation
    Else
        'bas
        tvwData.Nodes.Add , tvwFirst, objDataSource.Alias, objDataSource.Alias, 1, 2
        For i = 1 To objDataSource.Datasets.Count
            '添加数据集到数据集管理器
            Select Case objDataSource.Datasets(i).Type
                Case scdPoint
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 10
                Case scdLine
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 12
                Case scdRegion
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 4
                Case scdText
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 11
                Case scdCAD
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 13
                Case scdNetwork
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 3
                Case scdTIN
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 6
                Case scdECW
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 16
                Case scdMrSID
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 17
                Case Else
                    tvwData.Nodes.Add objDataSource.Alias, tvwChild, , objDataSource.Datasets(i).Name, 7
            End Select
        Next
    End If
    Set tvwData.SelectedItem = tvwData.Nodes(1)
    tvwData.Nodes(1).Expanded = True
     '刷新地图窗口
    SuperMap1.MarginPanEnable = False
    SuperMap1.Refresh
    '释放内存
    Set objDataSource = Nothing
    Set objlayer = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SuperMap1.Disconnect
    SuperMap1.Close
    SuperWorkspace1.Close
End Sub

Private Sub SuperMap1_GeometrySelected(ByVal nSelectedGeometryCount As Long)
    If nSelectedGeometryCount > 0 Then
        btnObjCopy.Enabled = True
        btnObjDelete.Enabled = True
        btnCreateBuffer.Enabled = True
        btnSelectionToDt.Enabled = True
        If nSelectedGeometryCount > 1 Then
              btnObjUnion.Enabled = True
        Else
              btnObjUnion.Enabled = False
        End If
        If SuperMap1.selection.Dataset.Type = scdLine Then
            If nSelectedGeometryCount > 1 Then
                btnObjIntersect.Enabled = True
                btnLineJoint.Enabled = True
            Else
                btnObjIntersect.Enabled = False
                btnLineJoint.Enabled = False
            End If
            btnLineToRegion.Enabled = True
            
            btnRegionToLine.Enabled = False
            btnObjXOR.Enabled = False
        ElseIf SuperMap1.selection.Dataset.Type = scdRegion Then
            If nSelectedGeometryCount > 1 Then
                btnObjIntersect.Enabled = True
                btnObjXOR.Enabled = True
            Else
                btnObjIntersect.Enabled = False
                btnObjXOR.Enabled = False
            End If
            btnRegionToLine.Enabled = True
            
            btnLineJoint.Enabled = False
            btnLineToRegion.Enabled = False
        Else
            If SuperMap1.selection.Dataset.Type = scdPoint Then
                  btnCreateBuffer.Enabled = True
            Else
                  btnCreateBuffer.Enabled = False
            End If
            btnLineJoint.Enabled = False
            btnLineToRegion.Enabled = False
            btnRegionToLine.Enabled = False
            btnObjXOR.Enabled = False
            btnObjIntersect.Enabled = False
        End If
    Else
        btnObjCopy.Enabled = False
        btnObjDelete.Enabled = False
        btnObjUnion.Enabled = False
        btnCreateBuffer.Enabled = False
        btnSelectionToDt.Enabled = False
        btnObjIntersect.Enabled = False
        btnLineJoint.Enabled = False
        btnLineToRegion.Enabled = False
        btnObjXOR.Enabled = False
        btnRegionToLine.Enabled = False
    End If
      
    Dim objGeometry As soGeometry
    Dim objRecordset As soRecordset
    
    Set objRecordset = SuperMap1.selection.ToRecordset(False)
    If Not (objRecordset Is Nothing) Then
        objRecordset.MoveFirst
        Set objGeometry = objRecordset.GetGeometry()
        If Not (objGeometry Is Nothing) Then
            If objGeometry.PartCount > 1 Then
                btnSplitObjects.Enabled = True
            Else
                btnSplitObjects.Enabled = False
            End If
        End If
    End If
    
    Set objRecordset = Nothing
    Set objGeometry = Nothing
      
End Sub

Private Sub tvwData_DblClick()
    Call btnOpenDatase_Click
End Sub

Private Sub tvwData_NodeClick(ByVal Node As MSComctlLib.Node) '树形节点选择
    If Node.Index = 1 Then
        btnDeleteDt.Enabled = False
        btnOpenDatase.Enabled = False
    Else
        btnDeleteDt.Enabled = True
        btnOpenDatase.Enabled = True
    End If
End Sub