📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "属性表编辑"
ClientHeight = 6690
ClientLeft = 45
ClientTop = 330
ClientWidth = 10020
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6690
ScaleWidth = 10020
StartUpPosition = 2 'CenterScreen
Begin SuperMapLib.SuperWorkspace SuperWorkspace
Left = 3060
Top = 2760
_Version = 327682
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin SuperMapLib.SuperMap SuperMap
Height = 6615
Left = 60
TabIndex = 11
Top = 60
Width = 7575
_Version = 327682
_ExtentX = 13361
_ExtentY = 11668
_StockProps = 160
End
Begin VB.Frame Frame2
Height = 1125
Left = 7665
TabIndex = 7
Top = 1080
Width = 2310
Begin VB.CommandButton btnModifyStructure
Caption = "维护表结构"
Height = 375
Left = 1170
TabIndex = 10
Top = 195
Width = 1065
End
Begin VB.CommandButton btnAttributeTable
Caption = "查看属性表"
Height = 375
Left = 75
TabIndex = 9
Top = 195
Width = 1065
End
Begin VB.ComboBox cmbDataset
Height = 315
Left = 90
Style = 2 'Dropdown List
TabIndex = 8
Top = 690
Width = 2160
End
End
Begin VB.Frame Frame1
Height = 1095
Left = 7650
TabIndex = 1
Top = -60
Width = 2340
Begin VB.CommandButton btnViewEntire
Caption = "全幅"
Height = 405
Left = 1200
TabIndex = 5
Top = 615
Width = 1035
End
Begin VB.CommandButton btnSelect
Caption = "选择"
Height = 405
Left = 105
TabIndex = 4
Top = 615
Width = 1035
End
Begin VB.CommandButton btnPan
Caption = "平移"
Height = 405
Left = 1200
TabIndex = 3
Top = 195
Width = 1035
End
Begin VB.CommandButton btnZoomFree
Caption = "自由缩放"
Height = 405
Left = 105
TabIndex = 2
Top = 195
Width = 1035
End
End
Begin MSComctlLib.ListView lvwObjAttribute
Height = 4065
Left = 7650
TabIndex = 0
Top = 2595
Width = 2340
_ExtentX = 4128
_ExtentY = 7170
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "字段值"
Object.Width = 2293
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "字段名"
Object.Width = 2117
EndProperty
End
Begin VB.Label Label1
Caption = "对象属性列表："
Height = 240
Left = 7740
TabIndex = 6
Top = 2355
Width = 1260
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================SuperMap Objects示范工程说明=======================================
'
'功能简介:
' 1、示范在SuperMap Objects中如何查询和修改数据集中几何对象的属性。
' 2、示范在SuperMap Objects中如何维护属性数据表：增加和删除用户字段。
'所用控件：SuperMap核心控件、SuperGridView控件。
'所用数据：..\Data\World\world.sdb。
'操作说明：
'1、点击"选择"按钮，在地图窗口中选择一个对象，"对象属性列表"中会列出其所有的属性。
' 在此表中点击字段值，可以修改该值。修改完后程序自动保存(类似在资源管理器中给改文件名)。
'2、点击"查看属性数据表"按钮，可以查询出其下的下拉列表框中选择的数据集的属性数据表。
' 在该表中也可以仿上面的操作来修改对象的属性值。
'3、注意：字段中，以"Sm"开头的是系统字段，除"SmUserID"的值可以修改以外，其余不允许修改。
' 非系统字段可以随便修改。
'4、点击"维护表结构"按钮，可以弹出"维护属性数据表结构"对话框，在该对话框中可以增加和删除
' 用户字段。系统字段不许删除。
'
'===================================SuperMap Objects示范工程说明结束=====================================
Option Explicit
Private Sub btnAttributeTable_Click() '查看属性表
If SuperWorkspace.Datasources.Count < 1 Then
MsgBox "当前工作空间中没有数据源", vbInformation
Exit Sub
End If
Dim objDs As soDataSource
Dim objDt As soDataset
Dim objDtVector As soDatasetVector
Dim objSourceRecordset As soRecordset
Dim strDtName As String
Set objDs = SuperWorkspace.Datasources.Item(1)
If objDs Is Nothing Then Exit Sub
strDtName = cmbDataset.Text
Set objDt = objDs.Datasets.Item(strDtName)
If objDt Is Nothing Then Exit Sub
If objDt.Vector = True Then
Set objDtVector = SuperWorkspace.Datasources(1).Datasets(cmbDataset.Text)
Set objSourceRecordset = objDtVector.Query("", True)
If Not (objSourceRecordset Is Nothing) Then
Set frmDatasetAttribute.objRecordset = objSourceRecordset
frmDatasetAttribute.lblDatasetName.Caption = strDtName
Select Case objDtVector.Type
Case scdPoint
frmDatasetAttribute.lblDatasetType.Caption = "点数据集"
Case scdLine
frmDatasetAttribute.lblDatasetType.Caption = "线数据集"
Case scdRegion
frmDatasetAttribute.lblDatasetType.Caption = "面数据集"
Case scdText
frmDatasetAttribute.lblDatasetType.Caption = "文本数据集"
Case scdNetwork
frmDatasetAttribute.lblDatasetType.Caption = "网络数据集"
Case Else
frmDatasetAttribute.lblDatasetType.Caption = "其它"
End Select
frmDatasetAttribute.Show , Me
End If
End If
End Sub
Private Sub btnModifyStructure_Click() '维护表结构
If SuperWorkspace.Datasources.Count < 1 Then
MsgBox "当前工作空间中没有数据源", vbInformation
Exit Sub
End If
frmModifyStructure.Show vbModal, Me
Dim objDs As soDataSource
Dim objDt As soDataset
Set objDs = SuperWorkspace.Datasources.Item(1)
If objDs Is Nothing Then Exit Sub
Set objDt = objDs.Datasets.Item("grid")
If Not objDt Is Nothing Then SuperMap.Layers.AddDataset objDt, True
Set objDt = objDs.Datasets.Item("world")
If Not objDt Is Nothing Then SuperMap.Layers.AddDataset objDt, False
SuperMap.Refresh
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
SuperMap.Refresh
End Sub
Private Sub btnZoomFree_Click() '自由缩放
SuperMap.Action = scaZoomFree
End Sub
Private Sub Form_Load()
SuperMap.Connect SuperWorkspace.Handle
Dim i As Integer
Dim objDs As soDataSource
Dim objDt As soDataset
Dim strDsName As String
strDsName = App.Path & "\..\Data\World\World.sdb"
Set objDs = SuperWorkspace.OpenDataSource(strDsName, "World", sceSDBPlus, False)
If objDs Is Nothing Then
MsgBox "打开数据源文件失败！", vbInformation
Else
Set objDt = objDs.Datasets.Item("Grid")
If Not objDt Is Nothing Then
SuperMap.Layers.AddDataset objDs.Datasets("Grid"), True
cmbDataset.AddItem "Grid"
End If
Set objDt = objDs.Datasets.Item("World")
If Not objDt Is Nothing Then
SuperMap.Layers.AddDataset objDs.Datasets("World"), False
cmbDataset.AddItem "World"
End If
End If
If cmbDataset.ListCount > 0 Then cmbDataset.ListIndex = 0
SuperMap.Action = scaNull
lvwObjAttribute.ColumnHeaders(1).Position = 2
End Sub
Private Sub Form_Unload(Cancel As Integer)
SuperMap.Close
SuperMap.Disconnect
SuperWorkspace.Close
End Sub
Private Sub lvwObjAttribute_AfterLabelEdit(Cancel As Integer, NewString As String)
'改变属性表中的值，更新记录
Dim objRecordset As soRecordset
Set objRecordset = frmMain.SuperMap.selection.ToRecordset(False)
If objRecordset Is Nothing Then
MsgBox "错误！", vbInformation
Exit Sub
End If
objRecordset.MoveFirst
objRecordset.Edit
objRecordset.SetFieldValue lvwObjAttribute.SelectedItem.SubItems(1), NewString
objRecordset.Update
End Sub
Private Sub lvwObjAttribute_ItemClick(ByVal Item As MSComctlLib.ListItem)
'判断lidtview的属性，只有SmUserID字段可改
If Left$(Item.SubItems(1), 2) = "Sm" Then '系统字段中只许编辑SmUserID
If Item.SubItems(1) = "SmUserID" Then
lvwObjAttribute.StartLabelEdit
End If
Else '非系统字段都允许编辑
lvwObjAttribute.StartLabelEdit
End If
End Sub
Private Sub SuperMap_GeometrySelected(ByVal nSelectedGeometryCount As Long) '选择几何对象后触发
Dim objRecordset As soRecordset
Dim objFieldInfo As soFieldInfo
Dim i As Integer
lvwObjAttribute.ListItems.Clear
Set objRecordset = SuperMap.selection.ToRecordset(False)
If objRecordset Is Nothing Then
MsgBox "错误!", vbAbortRetryIgnore
Else
For i = 1 To objRecordset.FieldCount
If Not IsNull(objRecordset.GetFieldValue(i)) Then
lvwObjAttribute.ListItems.Add , , objRecordset.GetFieldValue(i)
Else
lvwObjAttribute.ListItems.Add , , ""
End If
Set objFieldInfo = objRecordset.GetFieldInfo(i)
If Not (objFieldInfo Is Nothing) Then
lvwObjAttribute.ListItems(i).SubItems(1) = objFieldInfo.Name
End If
Next
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -