?? frmmain.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -