📄 frmmain.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Object = "{02BEE3A6-4264-45B0-93C8-76FBBA329150}#5.2#0"; "SUPERL~2.OCX"
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "图例示范"
ClientHeight = 6015
ClientLeft = 45
ClientTop = 330
ClientWidth = 8910
Icon = "frmMain.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6015
ScaleWidth = 8910
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin SuperMapLib.SuperMap SuperMap1
Height = 5415
Left = 2490
TabIndex = 15
Top = 510
Width = 6375
_Version = 327682
_ExtentX = 11245
_ExtentY = 9551
_StockProps = 160
Appearance = 1
End
Begin SuperMapLib.SuperWorkspace SuperWorkspace1
Left = 3540
Top = 1440
_Version = 327682
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin VB.CommandButton Command1
Caption = "退出"
Height = 435
Left = 7935
TabIndex = 14
Top = 30
Width = 945
End
Begin VB.CommandButton cmdAction
Caption = "刷新"
Height = 435
Index = 7
Left = 6300
TabIndex = 12
Top = 30
Width = 1035
End
Begin VB.Frame Frame1
Caption = "图例"
Height = 5520
Left = 0
TabIndex = 6
Top = 465
Width = 2415
Begin SuperLegendLib.SuperLegend SuperLegend1
Height = 3750
Left = 120
TabIndex = 16
Top = 225
Width = 2175
_Version = 327682
_ExtentX = 3836
_ExtentY = 6615
_StockProps = 132
Appearance = 1
End
Begin VB.CheckBox check1
Caption = "调整图层顺序"
Height = 240
Index = 5
Left = 150
TabIndex = 13
Top = 5220
Width = 1500
End
Begin VB.CheckBox check1
Caption = "单一展开"
Height = 240
Index = 4
Left = 150
TabIndex = 11
Top = 4995
Width = 1365
End
Begin VB.CheckBox check1
Caption = "编辑标签"
Height = 240
Index = 0
Left = 150
TabIndex = 10
Top = 4095
Width = 1365
End
Begin VB.CheckBox check1
Caption = "显示连接线"
Height = 255
Index = 2
Left = 150
TabIndex = 9
Top = 4545
Width = 1365
End
Begin VB.CheckBox check1
Caption = "显示+ / - 号"
Height = 240
Index = 3
Left = 150
TabIndex = 8
Top = 4770
Width = 1365
End
Begin VB.CheckBox check1
Caption = "弹出菜单"
Height = 255
Index = 1
Left = 150
TabIndex = 7
Top = 4320
Width = 1365
End
End
Begin VB.CommandButton cmdAction
Caption = "选择"
Height = 435
Index = 0
Left = 15
TabIndex = 5
Top = 30
Width = 1035
End
Begin VB.CommandButton cmdAction
Caption = "漫游"
Height = 435
Index = 1
Left = 1050
TabIndex = 4
Top = 30
Width = 1035
End
Begin VB.CommandButton cmdAction
Caption = "放大"
Height = 435
Index = 2
Left = 2100
TabIndex = 3
Top = 30
Width = 1035
End
Begin VB.CommandButton cmdAction
Caption = "缩小"
Height = 435
Index = 3
Left = 3150
TabIndex = 2
Top = 30
Width = 1035
End
Begin VB.CommandButton cmdAction
Caption = "自由缩放"
Height = 435
Index = 4
Left = 4200
TabIndex = 1
Top = 30
Width = 1035
End
Begin VB.CommandButton cmdAction
Caption = "全幅显示"
Height = 435
Index = 5
Left = 5250
TabIndex = 0
Top = 30
Width = 1035
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5850
Top = 3900
_ExtentX = 847
_ExtentY = 847
_Version = 393216
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控件、SuperLegend控件。
'所用数据：..\Data\World目录下的World.sdb和World.sdd两个文件
'操作说明：
' 1、选中图例中的文本图层，分别拖动到面图层的上面和下面，注意看地图窗口中文字的变化。
' 2、点击每层前面的检查框，选中和取消它，注意看地图窗口中文字的变化。
' 3、右击图例上某一项，会弹出一个快捷菜单，单击第一项"可显示"，取消前面的钩，看图例中的检查框和地图窗口的变化。
' 4、在图例的快捷菜单中，分别选中和取消"可编辑"，分别在地图窗口中选择一个该层的对象，并试试移动这一对象(用Ctrl +Z可以撤销操作)。
' 5、在图例的快捷菜单中，单击"风格设置"，可以设置所选图层的显示风格。
' 6、在图例的快捷菜单中，单击"专题图向导"，按照提示，可以制作各种专题地图。
' 7、在专题图的图例上，再试用"可显示"、"风格设置"。
' 8、双击专题图的图例，可以折叠。
' 9、检查框的说明：
' "编辑标签" --------- 设置图例控件的标签是否允许编辑(如果允许编辑，编辑的只是图层的标题而不是名称)
' "弹出菜单" --------- 设置图例控件是否弹出右键快捷菜单
' "显示连接线" ------- 设置图例控件是否显示各节点间的连接线
' "显示 + / - 号" ---- 设置图例控件有下级分支的节点前面是否显示+/- 号
' "单一展开" --------- 设置图例控件是否只展开被选中的节点(如果有下级分支的话)，而折叠其他的节点
' "调整图层顺序" ----- 设置或返回是否可以用鼠标拖动来调整图例控件中图层的顺序
'
'===================================SuperMap Objects示范工程说明结束=====================================
Option Explicit
Private Sub check1_Click(Index As Integer)
Select Case Index
Case 0
SuperLegend1.EditLabels = IIf(check1(0).Value = vbChecked, True, False)
Case 1
SuperLegend1.PopupMenu = IIf(check1(1).Value = vbChecked, True, False)
Case 2
SuperLegend1.HasLines = IIf(check1(2).Value = vbChecked, True, False)
Case 3
SuperLegend1.HasButtons = IIf(check1(3).Value = vbChecked, True, False)
Case 4
SuperLegend1.SingleExpand = IIf(check1(4).Value = vbChecked, True, False)
Case 5
SuperLegend1.ItemDragAndDrop = IIf(check1(5).Value = vbChecked, True, False)
End Select
SuperLegend1.Refresh
End Sub
Private Sub cmdAction_Click(Index As Integer)
Select Case Index
Case 0
SuperMap1.Action = scaSelect '点选
Case 1
SuperMap1.Action = scaPan '漫游
Case 2
SuperMap1.Action = scaZoomIn '放大
Case 3
SuperMap1.Action = scaZoomOut '缩小
Case 4
SuperMap1.Action = scaZoomFree '自由缩放
Case 5
SuperMap1.ViewEntire '全幅显示
Case 7
SuperMap1.Refresh '刷新
End Select
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim strAlias As String '数据源别名
Dim nEngineType As seEngineType '数据引擎类型
Dim strDataSourceName As String '数据源绝对路径名
Dim objDataSource As soDataSource '数据源对象,指向打开的数据源
Dim objlayer As soLayer '图层对象变量,指向将要打开的图层
Dim i As Integer '循环变量
Dim objThemeUnique As soThemeUnique '单值专题图对象
Dim objColor As New soColors '颜色集对象
Dim nThemeCount As Long '专题要素数目
SuperMap1.Connect SuperWorkspace1.Handle '地图与工作空间建立连接
SuperLegend1.Connect SuperMap1.Handle '图例控件与地图建立连接
nEngineType = sceSDBPlus 'SuperMap支持多种类型，此处为SDBPlus类型
strDataSourceName = App.Path & "\..\Data\World\World.sdb"
strAlias = "world"
'打开数据源
Set objDataSource = SuperWorkspace1.OpenDataSource(strDataSourceName, strAlias, nEngineType, False)
If objDataSource Is Nothing Then
MsgBox "打开数据源失败！", vbInformation
Else
'把数据源中的所有图层加入到SuperMap中
Set objlayer = SuperMap1.Layers.AddDataset(objDataSource.Datasets("grid"), True)
Set objlayer = SuperMap1.Layers.AddDataset(objDataSource.Datasets("world"), True)
Set objlayer = SuperMap1.Layers.AddDataset(objDataSource.Datasets("Country_Lable"), True)
End If
'刷新地图窗口
If SuperMap1.Layers.Count <= 0 Then Exit Sub
With SuperLegend1
.EditLabels = False
.HasLines = True
.PopupMenu = True
End With
check1(0).Value = IIf(SuperLegend1.EditLabels = True, vbChecked, vbUnchecked)
check1(1).Value = IIf(SuperLegend1.PopupMenu = True, vbChecked, vbUnchecked)
check1(2).Value = IIf(SuperLegend1.HasLines = True, vbChecked, vbUnchecked)
check1(3).Value = IIf(SuperLegend1.HasButtons = True, vbChecked, vbUnchecked)
check1(4).Value = IIf(SuperLegend1.SingleExpand = True, vbChecked, vbUnchecked)
check1(5).Value = IIf(SuperLegend1.ItemDragAndDrop = True, vbChecked, vbUnchecked)
SuperMap1.Action = scaSelect
'制作专题地图
Set objlayer = SuperMap1.Layers(2)
Set objThemeUnique = objlayer.ThemeUnique
With objThemeUnique
.Enable = True
.Field = "SmID"
.MakeDefault '必要，否则ValueCount的值为0
SuperMap1.Refresh '此时地图刷新的效果和下一次刷新的效果不同
nThemeCount = .ValueCount '获取专题要素的数目
objColor.MakeRandomColorset nThemeCount '产生一组随机色
For i = 1 To nThemeCount '设置各个专题元素的填充色
.Style(i).BrushColor = objColor(i)
Next i
End With
SuperMap1.Refresh '此时刷新的效果与上一次不同，您可以在两次刷新之间添加一个断点，观察不同的效果
SuperLegend1.Refresh
'释放内存
Set objDataSource = Nothing
Set objlayer = Nothing
Set objThemeUnique = Nothing
Set objColor = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
SuperLegend1.Disconnect
SuperMap1.Close
SuperMap1.Disconnect
SuperWorkspace1.Close
End Sub
Private Sub SuperLegend1_EditableLayerChanged(ByVal nIndex As Long)
SuperMap1.Layers.SetEditableLayer nIndex
End Sub
Private Sub SuperLegend1_Modified()
SuperMap1.Refresh
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -