📄 frmmain.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.1#0"; "SuperMap.ocx"
Object = "{02BEE3A6-4264-45B0-93C8-76FBBA329150}#5.1#0"; "SuperLegend.ocx"
Object = "{A61255F7-0A20-431C-86CE-78C14314BE9E}#5.1#0"; "SuperWkspManager.ocx"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "工作空间管理器"
ClientHeight = 6525
ClientLeft = 45
ClientTop = 330
ClientWidth = 8820
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6525
ScaleWidth = 8820
StartUpPosition = 3 'Windows Default
Begin SuperLegendLib.SuperLegend SuperLegend1
Height = 2895
Left = 120
TabIndex = 11
Top = 3480
Width = 2175
_Version = 327681
_ExtentX = 3836
_ExtentY = 5106
_StockProps = 132
End
Begin SuperWkspManagerLib.SuperWkspManager SuperWkspManager1
Height = 2835
Left = 60
TabIndex = 10
Top = 600
Width = 2235
_Version = 327681
_ExtentX = 3942
_ExtentY = 5001
_StockProps = 0
End
Begin SuperMapLib.SuperWorkspace SuperWorkspace1
Left = 3840
Top = 2460
_Version = 327681
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin SuperMapLib.SuperMap SuperMap1
Height = 5775
Left = 2400
TabIndex = 9
Top = 600
Width = 6315
_Version = 327681
_ExtentX = 11139
_ExtentY = 10186
_StockProps = 160
End
Begin VB.CommandButton Command1
Caption = "打开工作空间"
Height = 390
Index = 0
Left = 0
TabIndex = 8
Top = 0
Width = 1290
End
Begin VB.CommandButton Command1
Caption = "关闭工作空间"
Height = 390
Index = 2
Left = 1290
TabIndex = 7
Top = 0
Width = 1290
End
Begin VB.CommandButton Command1
Caption = "选择"
Height = 390
Index = 4
Left = 3135
TabIndex = 6
Top = 0
Width = 690
End
Begin VB.CommandButton Command1
Caption = "放大"
Height = 390
Index = 5
Left = 3825
TabIndex = 5
Top = 0
Width = 690
End
Begin VB.CommandButton Command1
Caption = "缩小"
Height = 390
Index = 6
Left = 4515
TabIndex = 4
Top = 0
Width = 690
End
Begin VB.CommandButton Command1
Caption = "自由缩放"
Height = 390
Index = 7
Left = 5205
TabIndex = 3
Top = 0
Width = 915
End
Begin VB.CommandButton Command1
Caption = "漫游"
Height = 390
Index = 8
Left = 6120
TabIndex = 2
Top = 0
Width = 690
End
Begin VB.CommandButton Command1
Caption = "刷新"
Height = 390
Index = 9
Left = 6810
TabIndex = 1
Top = 0
Width = 690
End
Begin VB.CommandButton Command1
Caption = "全幅显示"
Height = 390
Index = 1
Left = 7500
TabIndex = 0
Top = 0
Width = 915
End
Begin MSComDlg.CommonDialog cdlFile
Left = 0
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================SuperMap Objects示范工程说明=======================================
'
'功能简介：利用SuperwkspManager控件实现对工作空间的管理
'所用控件：SuperMap控件、SuperWorkspace控件、SuperwkspManager控件、SuperLegend控件
'所用数据：任意目录下的合法的*.smw文件
'操作说明：
' 1、单击“打开工作空间”，选择工作空间文件；
' 2、实现对地图的基本操作；
'
'
'===================================SuperMap Objects示范工程说明结束=====================================
Option Explicit
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0: Call OnFileOpenWorkspace
Case 1: SuperMap1.ViewEntire
Case 2: Call OnFileCloseWorkspace
Case 4: SuperMap1.Action = scaSelect
Case 5: SuperMap1.Action = scaZoomIn
Case 6: SuperMap1.Action = scaZoomOut
Case 7: SuperMap1.Action = scaZoomFree
Case 8: SuperMap1.Action = scaPan
Case 9: SuperMap1.Refresh
End Select
End Sub
'打开工作空间,成功返回True
Public Function OnFileOpenWorkspace() As Boolean
Dim strFileName As String
On Error GoTo ErrHandle:
With cdlFile
.DialogTitle = "打开工作空间"
.Filter = "SuperMap工作空间 (*.smw)|*.smw|工作空间文件 (*.sxw)|*.sxw,*.smw"
.ShowOpen
If .FileName <> "" And FileExist(.FileName) Then
strFileName = .FileName
Else
OnFileOpenWorkspace = False
Exit Function
End If
End With
If SuperWorkspace1.Datasources.Count > 0 Then Call OnFileCloseWorkspace
OnFileOpenWorkspace = SuperWorkspace1.Open(strFileName)
'连接工作空间和地图窗口，管理器和工作空间,图例和地图
SuperWkspManager1.Connect SuperWorkspace1
SuperMap1.Connect SuperWorkspace1.Handle
SuperLegend1.Connect SuperMap1.Handle
SuperMap1.Action = scaNull
SuperWkspManager1.Refresh
Exit Function
ErrHandle:
If Err.Number = 32775 Then
cdlFile.FileName = ""
Resume Next
End If
End Function
'关闭工作空间，成功返回True
Public Function OnFileCloseWorkspace() As Boolean
On Error GoTo ErrHandle
SuperMap1.Close
SuperMap1.Disconnect
SuperMap1.Refresh
SuperLegend1.Disconnect
SuperWorkspace1.Close
OnFileCloseWorkspace = True
SuperWkspManager1.Refresh
Exit Function
ErrHandle:
OnFileCloseWorkspace = False
Exit Function
End Function
'判断文件是否存在, 存在返回True(strFileName为绝对路径,含扩展名)
Public Function FileExist(strFileName As String) As Boolean
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
FileExist = FileSystem.FileExists(strFileName)
Set FileSystem = Nothing
End Function
Private Sub Form_Unload(Cancel As Integer)
OnFileCloseWorkspace
End
End Sub
Private Sub SuperLegend1_Modified()
SuperMap1.Refresh
End Sub
Private Sub SuperMap1_AfterMapDraw(ByVal hdc As stdole.OLE_HANDLE)
' SuperLegend1.Refresh
End Sub
'将数据集添加到地图窗口
Public Function AddDatasetToMap(strSelected As String, strParent As String) As Boolean
Dim objDataset As soDataset
Dim objDatasource As soDataSource
Dim objLayers As soLayers
Dim objLayer As soLayer
Set objDatasource = SuperWorkspace1.Datasources(strParent)
Set objDataset = objDatasource.Datasets(strSelected)
Set objLayers = SuperMap1.Layers
If objLayers.Count > 0 Then
objLayers.RemoveAll
End If
Set objLayer = objLayers.AddDataset(objDataset, True)
If objLayer Is Nothing Then
AddDatasetToMap = False
Exit Function
Else
AddDatasetToMap = True
End If
Set objDataset = Nothing
Set objDatasource = Nothing
Set objLayer = Nothing
Set objLayers = Nothing
End Function
Private Sub SuperWkspManager1_LDbClick(ByVal nFlag As SuperMapLib.seSelectedItemFlag, ByVal strSelected As String, ByVal strParent As String)
If nFlag = scsDataset Then
If AddDatasetToMap(strSelected, strParent) Then
SuperMap1.Refresh
SuperLegend1.Refresh
End If
ElseIf nFlag = scsMap Then
SuperMap1.OpenMap strSelected
SuperMap1.Refresh
SuperLegend1.Refresh
ElseIf nFlag = scsSymbolLib Then
SuperWorkspace1.Resources.SymbolLib.ShowEditor
ElseIf nFlag = scsLineStyleLib Then
SuperWorkspace1.Resources.LineStyleLib.ShowEditor
ElseIf nFlag = scsFillStyleLib Then
SuperWorkspace1.Resources.FillStyleLib.ShowEditor
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -