frmmain.frm

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

VERSION 5.00
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "对象精确编辑"
   ClientHeight    =   6345
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9150
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6345
   ScaleWidth      =   9150
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin SuperMapLib.SuperMap SuperMap 
      Height          =   5835
      Left            =   60
      TabIndex        =   9
      Top             =   480
      Width           =   9075
      _Version        =   327682
      _ExtentX        =   16007
      _ExtentY        =   10292
      _StockProps     =   160
      Appearance      =   1
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace 
      Left            =   2160
      Top             =   1740
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.CommandButton CmdEditNode 
      Caption         =   "编辑节点"
      Height          =   390
      Left            =   6450
      TabIndex        =   8
      Top             =   45
      Width           =   1005
   End
   Begin VB.CommandButton CmdAddNode 
      Caption         =   "增加节点"
      Height          =   390
      Left            =   5460
      TabIndex        =   7
      Top             =   45
      Width           =   1005
   End
   Begin VB.CommandButton Command1 
      Caption         =   "关闭"
      Height          =   390
      Left            =   8220
      TabIndex        =   6
      Top             =   45
      Width           =   930
   End
   Begin VB.CommandButton btnObjEdit 
      Caption         =   "精确编辑"
      Height          =   390
      Left            =   4440
      TabIndex        =   5
      Top             =   45
      Width           =   1005
   End
   Begin VB.CommandButton btnSelect 
      Caption         =   "选择对象"
      Height          =   390
      Left            =   3360
      TabIndex        =   4
      Top             =   45
      Width           =   1080
   End
   Begin VB.CommandButton btnViewEntire 
      Caption         =   "全幅"
      Height          =   390
      Left            =   2505
      TabIndex        =   3
      Top             =   45
      Width           =   855
   End
   Begin VB.CommandButton btnPan 
      Caption         =   "平移"
      Height          =   390
      Left            =   1650
      TabIndex        =   2
      Top             =   45
      Width           =   855
   End
   Begin VB.CommandButton btnZoomOut 
      Caption         =   "缩小"
      Height          =   390
      Left            =   795
      TabIndex        =   1
      Top             =   45
      Width           =   855
   End
   Begin VB.CommandButton btnZoomIn 
      Caption         =   "放大"
      Height          =   390
      Left            =   15
      TabIndex        =   0
      Top             =   45
      Width           =   780
   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控件、SuperWorkspace控件
'所用数据：..\Data\World\目录下的World.sdb和World.sdd两个文件
'操作方式：
'        1．点击"放大"、"缩小"、"平移"、"全幅"等按钮可以对地图进行基本操作。
'        2．点击"选择对象"按钮后，可以在地图上选择对象。
'        3．点击"精确编辑"按钮时，显示"精确编辑"对话框，进行对象编辑。如果地图中有选中的对象，则可以对其中的
'           第一个对象进行精确编辑；如果地图中没有选中的对象，则可在地图中选取要编辑的对象，对其进行进行精确编辑。
'        4. 当选中一个几何对象时，单击一下"增加节点"，SuperMap的状态就变为增加节点，在你需要增加节点的地方单击一
'           下，就自动增加了一个节点,可以增加很多个；在结束增加时，再单击"增加节点"按钮，结束增加节点状态；
'        5. 当选中一个几何对象时，单击一下"编辑节点"，SuperMap的状态就变为编辑节点，把你的鼠标移到你需要编辑节点，
'           鼠标自动变成带四个箭头的样子，此时按下鼠标，通过拖动鼠标来改变这个节点的位置；可以通过这种方式改变其它
'           节点的位置.在结束编辑时，再单击"编辑节点"按钮，结束编辑节点状态；
'
'===================================SuperMap Objects示范工程说明结束=====================================
Option Explicit
Dim objError As soError

Private Sub btnObjEdit_Click()
     '精确编辑
     If frmMain.SuperMap.selection.Count > 0 Then
        Dim objGeometry As soGeometry
        Dim objRecordset As soRecordset
        Dim strLayerName As String
        Dim i As Integer
        Set objRecordset = Me.SuperMap.selection.ToRecordset(False)
        If objRecordset Is Nothing Then
            MsgBox objError.LastErrorMsg, vbInformation
            Exit Sub
        End If
        Set objGeometry = objRecordset.GetGeometry()
        If objGeometry Is Nothing Then
            MsgBox objError.LastErrorMsg, vbInformation
            Exit Sub
        End If
        '初始化精确编辑对话框
        frmObjEdit.lblPartCount.Caption = objGeometry.PartCount
        frmObjEdit.cmbCurrentPart.Clear
        For i = 1 To objGeometry.PartCount
            frmObjEdit.cmbCurrentPart.AddItem i
        Next
        frmObjEdit.cmbCurrentPart.ListIndex = 0
        frmObjEdit.lblCurrentMap.Caption = Me.Caption
        With frmMain.SuperMap.selection.Dataset
            frmObjEdit.lblCurrentLayer.Caption = .Name & "@" & .DataSourceAlias
        End With
        frmObjEdit.lblCurrentLayer.ToolTipText = frmObjEdit.lblCurrentLayer.Caption
        frmObjEdit.Show , Me
        '释放内存
        Set objRecordset = Nothing
        Set objGeometry = Nothing
     Else
        MsgBox "请先选中要精确编辑的对象！", vbInformation
     End If

End Sub

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

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

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

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

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

Private Sub CmdAddNode_Click()
    If SuperMap.Action = scaEditVertexAdd Then
        SuperMap.Action = scaSelect
    Else
        SuperMap.Action = scaEditVertexAdd
    End If
End Sub

Private Sub CmdEditNode_Click()
    If SuperMap.Action = scaEditVertexEdit Then
        SuperMap.Action = scaSelect
    Else
        SuperMap.Action = scaEditVertexEdit
    End If
End Sub

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    Dim objDatasource As soDataSource
    '建立SuperMap与SuperWorkspace之间的联系
    SuperMap.Connect SuperWorkspace.Handle
    '打开数据源
    Set objDatasource = SuperWorkspace.OpenDataSource(App.Path & "\..\Data\World\world.sdb", "world", sceSDBPlus, False)
    '添加数据集到地图窗口
    SuperMap.Layers.AddDataset objDatasource.Datasets("world"), True
    SuperMap.Layers.SetEditableLayer 1
End Sub

Private Sub Form_Resize()
    SuperMap.Width = Me.ScaleWidth - 2 * SuperMap.Left
    SuperMap.Height = Me.ScaleHeight - SuperMap.Top
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SuperMap.Close
    SuperMap.Disconnect
    SuperWorkspace.Close
End Sub

Private Sub SuperMap_GeometrySelected(ByVal nSelectedGeometryCount As Long)
    Dim objRecordset As soRecordset
    Dim objGeometry As soGeometry
    Dim j As Integer
    
    Set objRecordset = Me.SuperMap.selection.ToRecordset(False)
    If objRecordset Is Nothing Then
        MsgBox LoadResString(5155), vbInformation
        Exit Sub
    End If
    Set objGeometry = objRecordset.GetGeometry()
    If objGeometry Is Nothing Then
        MsgBox LoadResString(5155), vbInformation
        Exit Sub
    End If
    frmObjEdit.lblPartCount.Caption = objGeometry.PartCount
    '更新列表
    frmObjEdit.cmbCurrentPart.Clear
    For j = 1 To objGeometry.PartCount
        frmObjEdit.cmbCurrentPart.AddItem j
    Next
    frmObjEdit.cmbCurrentPart.ListIndex = 0
    frmObjEdit.lblCurrentMap.Caption = Me.Caption
    With frmMain.SuperMap.selection.Dataset
        frmObjEdit.lblCurrentLayer.Caption = .Name & "@" & .DataSourceAlias
    End With
    frmObjEdit.lblCurrentLayer.ToolTipText = frmObjEdit.lblCurrentLayer.Caption

End Sub