📄 frmmain.frm
字号:
VERSION 5.00
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Object = "{AB69DB6A-F6B5-4BCD-BF57-170D7A3F41F5}#5.2#0"; "SuperGridView.ocx"
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "由面生成面心点数据/由点数据的属性更新面数据的属性"
ClientHeight = 6780
ClientLeft = 45
ClientTop = 330
ClientWidth = 9105
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6780
ScaleWidth = 9105
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 480
Left = 7950
TabIndex = 8
Top = 30
Width = 1035
End
Begin SuperGridViewLib.SuperGridView SuperGridView1
Height = 1110
Left = 60
TabIndex = 11
Top = 5625
Width = 8895
_Version = 327682
_ExtentX = 15690
_ExtentY = 1958
_StockProps = 0
End
Begin VB.CommandButton cmdUpRegion
Caption = "点属性更新面属性"
Height = 480
Left = 6975
TabIndex = 10
Top = 30
Width = 990
End
Begin VB.CommandButton cmdRegion2Pt
Caption = "面->面心点"
Height = 480
Left = 5985
TabIndex = 9
Top = 30
Width = 1005
End
Begin VB.CommandButton cmdViewEnt
Caption = "全幅"
Height = 480
Left = 4995
TabIndex = 7
Top = 30
Width = 1005
End
Begin VB.CommandButton cmdPan
Caption = "漫游"
Height = 480
Left = 4005
TabIndex = 6
Top = 30
Width = 1005
End
Begin VB.CommandButton cmdZoomFree
Caption = "自由缩放"
Height = 480
Left = 3015
TabIndex = 5
Top = 30
Width = 1005
End
Begin VB.CommandButton cmdZoomOut
Caption = "缩小"
Height = 480
Left = 2025
TabIndex = 4
Top = 30
Width = 1005
End
Begin VB.CommandButton cmdZoomIn
Caption = "放大"
Height = 480
Left = 1035
TabIndex = 3
Top = 30
Width = 1005
End
Begin VB.CommandButton cmdSelect
Caption = "选择"
Height = 480
Left = 45
TabIndex = 2
Top = 30
Width = 1005
End
Begin VB.Frame Frame1
Height = 5070
Left = 60
TabIndex = 0
Top = 525
Width = 8910
Begin SuperMapLib.SuperMap SuperMap
Height = 4860
Left = 45
TabIndex = 1
Top = 120
Width = 8805
_Version = 327682
_ExtentX = 15531
_ExtentY = 8572
_StockProps = 160
Appearance = 1
End
End
Begin SuperMapLib.SuperWorkspace SuperWorkspace
Left = 1785
Top = 1005
_Version = 327682
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
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控件、SuperWorkspace控件和SuperGridView控件
'所用数据：..\Data\CentroidPoints\data.sdb
'操作说明：
' 1、点击“面->面心点”按钮，程序在每一个面对象的内部生成一个点对象，保存到点数据集中，并将面对象的属性赋给点对象
' 2、点击“点属性更新面属性”按钮，程序根据点和面对象的被包含关系，用点的属性去更新面的属性
'
'===================================SuperMap Objects示范工程说明结束=====================================
Option Explicit
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPan_Click() '漫游
SuperMap.Action = scaPan
End Sub
Private Sub cmdRegion2Pt_Click() '由面生成面心点数据
Dim objDs As soDataSource
Dim objDt As soDataset
Dim objDtv As soDatasetVector
Dim objRs As soRecordset
Dim objLayer As soLayer
Dim strLayerName As String
Set objDs = SuperWorkspace.Datasources(1)
If objDs Is Nothing Then Exit Sub
'获得点数据集，如果已经存在，则先删除
Set objDt = objDs.Datasets("Centroid")
If Not objDt Is Nothing Then
strLayerName = "centroid@" & objDs.Alias
Set objLayer = SuperMap.Layers.Item(strLayerName)
If Not objLayer Is Nothing Then
Set objLayer = Nothing
SuperMap.Layers.RemoveAt strLayerName
End If
Set objDt = Nothing
objDs.DeleteDataset "Centroid"
End If
'获得面数据集，生成面心点，名称默认为Centroid
Set objDtv = objDs.Datasets("New_Region")
If objDtv Is Nothing Then Exit Sub
Set objDtv = objDs.CreateCentroidPoints(objDtv, "Centroid")
'将Centroid数据集添加到地图窗口中显示
SuperMap.Layers.AddDataset objDtv, True
SuperMap.Refresh
Set objRs = objDtv.Query("", True)
SuperGridView1.Connect objRs
SuperGridView1.Update
End Sub
Private Sub cmdSelect_Click() '选择
SuperMap.Action = scaSelect
End Sub
Private Sub cmdUpRegion_Click() '用面心点数据集来更新面的属性
Dim objDtvP As soDatasetVector
Dim objDtvR As soDatasetVector
Dim objDtvTable As soDatasetVector
Dim objDt As soDataset
Dim objDs As soDataSource
Dim objRst As soRecordset
Set objDs = SuperWorkspace.Datasources(1)
If objDs Is Nothing Then Exit Sub
'获得面心点数据集
Set objDt = objDs.Datasets("Centroid")
If objDt Is Nothing Then '如果没有创建过，弹出提示信息
MsgBox "请先创建面心点数据集", vbInformation, "信息提示"
Exit Sub
End If
If Not objDt Is Nothing Then
Set objDtvP = objDt
'获得需要更新属性的面数据集
Set objDtvR = objDs.Datasets("New_Region")
'更新属性的时候会将未处理对象保存到新的数据集中，
'这里先判断是否已经存在，如果已经存在则先删除
Set objDtvTable = objDs.Datasets("ErrorTable")
If Not objDtvTable Is Nothing Then
Set objDtvTable = Nothing
objDs.DeleteDataset ("ErrorTable")
End If
'更新面属性
objDs.UpdateByCentroidPoints objDtvP, objDtvR, "ErrorTable"
Set objRst = objDtvR.Query("", False)
If Not objRst Is Nothing Then
SuperGridView1.Connect objRst
SuperGridView1.Update
End If
End If
End Sub
Private Sub cmdViewEnt_Click() '全幅显示
SuperMap.ViewEntire
SuperMap.Refresh
End Sub
Private Sub cmdZoomFree_Click() '自由缩放
SuperMap.Action = scaZoomFree
End Sub
Private Sub cmdZoomIn_Click() '放大
SuperMap.Action = scaZoomIn
End Sub
Private Sub cmdZoomOut_Click() '缩小
SuperMap.Action = scaZoomOut
End Sub
Private Sub Form_Load()
Dim objDs As soDataSource
Dim objDt As soDataset
SuperMap.Connect SuperWorkspace.Handle
Set objDs = SuperWorkspace.OpenDataSource(App.Path & "\..\Data\CentroidPoints\data.sdb", "World", sceSDBPlus, False)
If objDs Is Nothing Then
MsgBox "打开数据源失败"
Exit Sub
End If
Set objDt = objDs.Datasets("New_Region")
If objDt Is Nothing Then Exit Sub
SuperMap.Layers.AddDataset objDt, True
SuperMap.ViewEntire
End Sub
Private Sub Form_Unload(Cancel As Integer)
SuperGridView1.Disconnect
SuperMap.Close
SuperMap.Disconnect
SuperWorkspace.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -