frmmain.frm

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

         Left            =   75
         Picture         =   "frmMain.frx":1F6E
         Style           =   1  'Graphical
         TabIndex        =   1
         ToolTipText     =   "画点"
         Top             =   225
         Width           =   375
      End
   End
   Begin MSComctlLib.TreeView tvwDS 
      Height          =   1095
      Left            =   6675
      TabIndex        =   34
      ToolTipText     =   "双击打开选择的数据集"
      Top             =   4125
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   1931
      _Version        =   393217
      HideSelection   =   0   'False
      LabelEdit       =   1
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
   End
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   4665
      Left            =   30
      TabIndex        =   35
      Top             =   525
      Width           =   6570
      _Version        =   327682
      _ExtentX        =   11589
      _ExtentY        =   8229
      _StockProps     =   160
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================SuperMap Objects示范工程说明=======================================================
'
'功能简介：示范SuperMap Objects中怎样创建、编辑和删除数据集，同时展示SuperMap Objects 中超强的捕捉功能。
'所用控件：SuperMap 控件、SuperWorkspace 控件
'所用数据：用户自己创建的数据(建议存放在当前目录下)
'操作说明：
'        1、点击"创建数据源"，创建一个新的数据源文件，成功后会添加到"数据列表"中。
'        2、点击"创建数据集"，可以创建一个指定类型的数据集，成功后会添加到"数据列表"中。
'        3、在"数据列表"中双击一个数据集,可以在地图窗口中打开它；或者选中后，点击"打开数据集"也可以打开它。选中一个数据集，
'           点击"删除数据集"可以从数据源中删除该数据集。
'        4、地图窗口中所的图层都会列在"图层列表"和"捕捉以下图层"按钮下的列表中。
'        5、点击"编辑图层"按钮，可以编辑在"图层列表"下拉列表框中选择的图层。选取"绘图工具"中的工具，就可以画出对象了。
'        6、进行捕捉：先在"捕捉以下图层"按钮下的列表中选择好要捕捉的图层，点击"捕捉以下图层"，就可以在编辑时进行捕捉。
'        7、捕捉设置：点击"捕捉设置"按钮，弹出一个对话框，可以对捕捉进行设置。其中可以设置要捕捉什么，不捕捉什么，还可以
'           拖动项来调整捕捉的优先级。
'        8、点击"清除图层"可以删除地图窗口中的所有图层。
'        9、使用"地图操作"中的按钮，可以对地图进行"放大"、"缩小"等操作。
'        10、在编辑某个图层时，可以用"地图操作"中的"选择"工具选中一个该图层的对象来修改该对象：如移动、复制(按下Ctrl键的拖动)、
'            改变形状(拖动控制点)、旋转(选中对象后，有一个旋转句柄，按下鼠标左键移动鼠标即可)。
'        11、注意：增加编辑文本时，第一次点击鼠标为开始编辑，可以输入文本。完成后，再点击一次鼠标表示结束这一文本的编辑。
'
'===================================SuperMap Objects示范工程说明结束=======================================================

Option Explicit

Public Function PathToName(ByVal strPath As String) As String
'=====================================================
'自定义函数,将文件全路径名转化为文件名(无路径名,无扩展名)
'=====================================================
    Dim iLength As Integer      '字符串长度
    Dim i As Integer
    Dim strTemp As String
    Dim strTemp1 As String
    Dim iPosition As Integer
    
    iPosition = 999
    If InStr(strPath, ".") <> 0 Then
        strTemp = Left(strPath, Len(strPath) - 4)
    Else
        strTemp = strPath
    End If
    
    iLength = Len(strTemp)
    For i = Len(strPath) To 1 Step -1
        If Mid$(strTemp, i, 1) = "\" Then
            iPosition = i
            Exit For
        End If
    Next
    If iPosition = 999 Then
        PathToName = strTemp
    Else
        PathToName = Right(strTemp, iLength - iPosition)
    End If
End Function

Private Sub btnClearLayers_Click() '清除图层
    SuperMap1.Layers.RemoveAll
    SuperMap1.Action = scaNull
    SuperMap1.Refresh
    
    cmbEditbleLayer.Clear
    lvwSnapableLayer.ListItems.Clear
    
    btnClearLayers.Enabled = True
    btnEditDataset.Enabled = False
    btnStartSnap.Enabled = False
End Sub

Private Sub btnCreateDataset_Click() '创建数据集
    If frmMain.SuperWorkspace1.Datasources.Count > 0 Then
        frmNewDataset.Show vbModal, frmMain
    End If
End Sub

Private Sub btnCreateDataSource_Click()
    '创建数据源
    Dim objDS As soDataSource
    Dim strDsName As String
    Dim strDsAlias As String
    
    If tvwDS.Nodes.Count = 0 Then
        tvwDS.Nodes.Add , tvwFirst, "workspace", "工作空间", 8
    End If
    
    With CommonDialog1
        .DialogTitle = "保存数据源文件"
        .CancelError = False
        .Filter = "SuperMap 数据源文件(*.sdb)|*.sdb"
        .Flags = cdlOFNOverwritePrompt
        .InitDir = App.Path
        .FileName = ""
        .ShowSave
        If .FileName <> "" Then
            strDsName = .FileName
        Else
            Exit Sub
        End If
    End With
    
    strDsAlias = PathToName(strDsName)
    Set objDS = Me.SuperWorkspace1.CreateDataSource(strDsName, strDsAlias, sceSDBPlus, False, False, False, "")
    If objDS Is Nothing Then
        MsgBox "数据源创建失败！", vbInformation
        btnCreateDataset.Enabled = False
    Else
        Me.tvwDS.Nodes.Add "workspace", tvwChild, "A" & strDsAlias, strDsAlias, 8
        Me.tvwDS.Nodes(1).Expanded = True
        btnCreateDataset.Enabled = True
        MsgBox "数据源创建成功！", vbInformation
    End If
End Sub

Private Sub btnDelDataset_Click() '删除数据集
    If tvwDS.Nodes.Count <= 1 Then Exit Sub
    If tvwDS.SelectedItem Is Nothing Then Exit Sub
    If tvwDS.SelectedItem.Text = "工作空间" Then Exit Sub
    If tvwDS.SelectedItem.Parent.Text = "工作空间" Then Exit Sub
    
    Dim objDS As soDataSource
    Dim strDtName As String
    Dim strLayerName As String
    
    strDtName = Me.tvwDS.SelectedItem.Text
    strLayerName = strDtName & "@" & Me.tvwDS.SelectedItem.Parent.Text
    If Not (SuperMap1.Layers(strLayerName) Is Nothing) Then
        SuperMap1.Layers.RemoveAt strLayerName
        SuperMap1.Refresh
        cmbEditbleLayer.RemoveItem lvwSnapableLayer.ListItems(strLayerName).Index - 1
        lvwSnapableLayer.ListItems.Remove strLayerName
    End If
    
    Set objDS = SuperWorkspace1.Datasources(1)
    If objDS Is Nothing Then
        MsgBox "错误！", vbInformation
    Else
        If objDS.DeleteDataset(strDtName) Then
            Me.tvwDS.Nodes.Remove Me.tvwDS.SelectedItem.Index
        End If
    End If
End Sub

Private Sub btnEditDataset_Click()
    '编辑图层
    Dim i As Integer
    Dim objLayer As soLayer
    
    If cmbEditbleLayer.ListIndex = -1 Then
        MsgBox "请先从右侧列表中选择要编辑的图层！", vbInformation
        Exit Sub
    End If
    
    Set objLayer = SuperMap1.Layers(cmbEditbleLayer.Text)
    If objLayer Is Nothing Then
        MsgBox "错误！", vbInformation
        Exit Sub
    End If
    
    SuperMap1.Layers.SetEditableLayer cmbEditbleLayer.Text
    Frame1.Enabled = True
    
    Select Case SuperMap1.Layers.GetEditableLayer().Dataset.Type
        Case scdPoint
            optEdit(0).Enabled = True
            For i = 1 To 12
                optEdit(i).Enabled = False
            Next
        Case scdLine
            optEdit(0).Enabled = False
            For i = 1 To 11
                optEdit(i).Enabled = True
            Next
            optEdit(12).Enabled = False
        Case scdRegion
            For i = 0 To 4
                optEdit(i).Enabled = False
            Next
            For i = 5 To 11
                optEdit(i).Enabled = True
            Next
            optEdit(12).Enabled = False
        Case scdText
            For i = 0 To 11
                optEdit(i).Enabled = False
            Next
            optEdit(12).Enabled = True
        Case Else
            MsgBox "不支持所选图层的编辑！", vbInformation
            For i = 0 To 12
                optEdit(i).Enabled = False
            Next
    End Select
End Sub

Private Sub btnOpenDataset_Click() '打开数据集
    Dim objDS As soDataSource
    Dim objDt As soDataset
    
    Dim strDtName As String
    Dim strLayName As String
    Dim i As Integer
    
    If tvwDS.Nodes.Count <= 1 Then Exit Sub
    If tvwDS.SelectedItem Is Nothing Then Exit Sub
    If tvwDS.SelectedItem.Text = "工作空间" Then Exit Sub
    If tvwDS.SelectedItem.Parent.Text = "工作空间" Then Exit Sub
    
    strDtName = Me.tvwDS.SelectedItem.Text
    Set objDS = SuperWorkspace1.Datasources(tvwDS.SelectedItem.Parent.Text)
    If objDS Is Nothing Then
        MsgBox "错误！", vbInformation
        Exit Sub
    Else
        Set objDt = objDS.Datasets(strDtName)
        If objDt Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
        End If
    End If
    
    strLayName = objDt.Name & "@" & objDS.Alias
    For i = 1 To SuperMap1.Layers.Count
        If SuperMap1.Layers(i).Name = strLayName Then
            MsgBox "该数据集已经被打开了。"
            Exit Sub
        End If
    Next i
    
    SuperMap1.Layers.AddDataset objDt, False
    SuperMap1.Refresh
    
    cmbEditbleLayer.AddItem strLayName
    lvwSnapableLayer.ListItems.Add , strLayName, strLayName
    btnEditDataset.Enabled = True
    btnClearLayers.Enabled = True
    btnStartSnap.Enabled = True
    
    If cmbEditbleLayer.ListCount = 1 Then cmbEditbleLayer.ListIndex = 0
    
    Frame1.Enabled = False
    For i = 0 To 12
        optEdit(i).Enabled = False
        optEdit(i).Value = False
    Next
End Sub

Private Sub btnPan_Click()
    Dim i As Integer
    
    For i = 0 To optEdit.Count - 1
        optEdit(i).Value = False
    Next
    SuperMap1.Action = scaPan
End Sub

Private Sub btnRefresh_Click()
    SuperMap1.Refresh
End Sub

Private Sub btnSelect_Click()
    Dim i As Integer
    
    For i = 0 To optEdit.Count - 1
        optEdit(i).Value = False
    Next
    SuperMap1.Action = scaSelect
End Sub

Private Sub btnSnapSet_Click()
    SuperMap1.ShowSnapSettingDialog
End Sub

Private Sub btnStartSnap_Click()
    Dim i As Integer
    
    For i = 1 To lvwSnapableLayer.ListItems.Count
        If lvwSnapableLayer.ListItems(i).Checked = True Then
            SuperMap1.Layers(lvwSnapableLayer.ListItems(i).Text).Snapable = True
        Else
            SuperMap1.Layers(lvwSnapableLayer.ListItems(i).Text).Snapable = False
        End If
    Next
    SuperMap1.Refresh
End Sub

Private Sub btnviewEntire_Click()
    SuperMap1.ViewEntire
End Sub

Private Sub btnZoomIn_Click()
    Dim i As Integer
    
    For i = 0 To optEdit.Count - 1
        optEdit(i).Value = False
    Next
    SuperMap1.Action = scaZoomIn
End Sub

Private Sub btnZoomOut_Click()
    Dim i As Integer
    
    For i = 0 To optEdit.Count - 1
        optEdit(i).Value = False
    Next
    SuperMap1.Action = scaZoomOut
End Sub

Private Sub Form_Load()
    SuperMap1.Connect SuperWorkspace1.Object
          
    tvwDS.Nodes.Add , tvwFirst, "workspace", "工作空间", 1
    SuperMap1.Action = scaSelect
End Sub

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

Private Sub optEdit_Click(Index As Integer)
      '设置SuperMap1数据集的相应的编辑状态
    Select Case Index
        Case 0
            SuperMap1.Action = scaEditCreatePoint
        Case 1
            SuperMap1.Action = scaEditCreateLinesect
        Case 2
            SuperMap1.Action = scaEditCreatePolyline
        Case 3
            SuperMap1.Action = scaEditCreateCurve
        Case 4
            SuperMap1.Action = scaEditCreateArc3P
        Case 5
            SuperMap1.Action = scaEditCreateRectangle
        Case 6
            SuperMap1.Action = scaEditCreateRoundRectangle
        Case 7
            SuperMap1.Action = scaEditCreateCircle
        Case 8
            SuperMap1.Action = scaEditCreateEllipse
        Case 9
            SuperMap1.Action = scaEditCreateObliqueEllipse
        Case 10
            SuperMap1.Action = scaEditCreatePolygon
        Case 11
            SuperMap1.Action = scaEditCreateParallelogram
        Case 12
            SuperMap1.Action = scaEditCreateText
    End Select
End Sub

Private Sub SuperMap1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        Dim i As Integer
        For i = 0 To 12
            optEdit(i).Value = False
        Next i
    End If
End Sub

Private Sub tvwDS_DblClick()
    btnOpenDataset_Click
End Sub

Private Sub tvwDS_NodeClick(ByVal Node As MSComctlLib.Node)
    If Node.Index > 2 Then
        btnDelDataset.Enabled = True
        btnOpenDataset.Enabled = True
    Else
        btnDelDataset.Enabled = False
        btnOpenDataset.Enabled = False
    End If
End Sub