📄 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 = 5295
ClientLeft = 45
ClientTop = 330
ClientWidth = 8685
Icon = "frmMain.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5295
ScaleWidth = 8685
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin SuperMapLib.SuperMap SuperMap1
Height = 4740
Left = 30
TabIndex = 11
Top = 525
Width = 7275
_Version = 327682
_ExtentX = 12832
_ExtentY = 8361
_StockProps = 160
Appearance = 1
End
Begin SuperMapLib.SuperWorkspace SuperWorkspace1
Left = 3840
Top = 1620
_Version = 327682
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin VB.CommandButton btnAction
Caption = "刷新"
Height = 450
Index = 7
Left = 6480
TabIndex = 7
Top = 30
Width = 1065
End
Begin VB.CommandButton btnAction
Caption = "选择"
Height = 450
Index = 0
Left = 15
TabIndex = 6
Top = 30
Width = 1065
End
Begin VB.CommandButton btnAction
Caption = "漫游"
Height = 450
Index = 1
Left = 1080
TabIndex = 5
Top = 30
Width = 1065
End
Begin VB.CommandButton btnAction
Caption = "放大"
Height = 450
Index = 2
Left = 2160
TabIndex = 4
Top = 30
Width = 1065
End
Begin VB.CommandButton btnAction
Caption = "缩小"
Height = 450
Index = 3
Left = 3240
TabIndex = 3
Top = 30
Width = 1065
End
Begin VB.CommandButton btnAction
Caption = "自由缩放"
Height = 450
Index = 4
Left = 4320
TabIndex = 2
Top = 30
Width = 1065
End
Begin VB.CommandButton btnAction
Caption = "全幅显示"
Height = 450
Index = 5
Left = 5400
TabIndex = 1
Top = 30
Width = 1065
End
Begin VB.CommandButton btnAction
Caption = "退出"
Height = 450
Index = 6
Left = 7575
TabIndex = 0
Top = 30
Width = 1065
End
Begin VB.Frame Frame1
Height = 975
Left = 7335
TabIndex = 8
Top = 450
Width = 1335
Begin VB.OptionButton OptPicAvi
Caption = "显示视频"
Height = 255
Index = 1
Left = 120
TabIndex = 10
Top = 600
Width = 1095
End
Begin VB.OptionButton OptPicAvi
Caption = "显示图片"
Height = 255
Index = 0
Left = 120
TabIndex = 9
Top = 240
Width = 1095
End
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控件。
'所用数据：\Data\Multimedia\SampleData.sdb和SampleData.sdd两个文件
'操作说明：
' 1、单击"选择"、"放大"、"缩小"、"自由缩放"、"全幅显示"、"漫游"、"刷新"进行相应的地图操作
' 2、选择"显示图片"，在SuperMap1上选择一个记录，则有相应的图片窗口弹出；
' 3、选择"显示视频"，在SuperMap1上选择一个记录，则有相应的AVI视频窗口弹出；
'
'===================================SuperMap Objects示范工程说明结束========================================
Option Explicit
Private Sub btnAction_Click(Index As Integer)
'设置SuperMap1的操作状态
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 6
SuperMap1.Layers.RemoveAll
SuperMap1.Disconnect
SuperMap1.Close
SuperWorkspace1.Datasources.RemoveAll
SuperWorkspace1.Close
End
Case 7
SuperMap1.Refresh
End Select
SuperMap1.Refresh
End Sub
Private Sub Form_Load()
SuperMap1.Connect SuperWorkspace1.Handle
Dim strAlias As String '数据源别名
Dim nEngineType As seEngineType '数据引擎类型
Dim strDataSourceName As String '数据源绝对路径名
Dim objDataSource As soDataSource '数据源对象,指向打开的数据源
Dim objLayer As soLayer '图层对象变量,指向将要打开的图层
Dim i As Integer '循环变量
nEngineType = sceSDBPlus 'SuperMap支持多种类型，此处为SDB类型
strDataSourceName = App.Path & "\..\Data\Multimedia\sampledata.sdb" 'CommonDialog1.FileName
strAlias = "world"
'打开数据源
Set objDataSource = SuperWorkspace1.OpenDataSource(strDataSourceName, strAlias, nEngineType, True)
If objDataSource Is Nothing Then
MsgBox "打开数据源失败！", vbInformation
Else
For i = 1 To objDataSource.Datasets.Count
'把数据源中的所有图层加入到SuperMap中
Set objLayer = SuperMap1.Layers.AddDataset(objDataSource.Datasets.Item(i), True)
Next
End If
'刷新地图窗口
If SuperMap1.Layers.Count <= 0 Then Exit Sub
SuperMap1.Refresh
'释放内存
Set objDataSource = Nothing
Set objLayer = Nothing
End Sub
Private Sub SuperMap1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim objpnt As New soGeoPoint
Dim objDTV As soDatasetVector
Dim objRcd As soRecordset
'转换平面坐标位地理坐标
objpnt.x = SuperMap1.PixelToMapX(ScaleX(x, vbTwips, vbPixels))
objpnt.y = SuperMap1.PixelToMapY(ScaleX(y, vbTwips, vbPixels))
'获取用来查询的数据集
Set objDTV = SuperMap1.Layers(1).Dataset
'在相应的数据集上进行空间选择，并保存记录
Set objRcd = objDTV.QueryEx(objpnt, scsPointInPolygon, "")
If objRcd Is Nothing Then Exit Sub
If objRcd.RecordCount < 1 Then Exit Sub
SuperMap1.selection.RemoveAll
'报查到的记录追加到选择集合中，并亮显
SuperMap1.selection.FromRecordset objRcd
SuperMap1.Refresh
objRcd.MoveFirst
Dim flname As String
If OptPicAvi(0).Value = True Then
If IsNull(Trim(objRcd.GetFieldValue("Pic"))) Then
FrmPic.Hide
FrmAvi.Hide
Exit Sub
End If
'读取图片名称
flname = Trim(objRcd.GetFieldValue("Pic"))
'装载图片并显示
FrmPic.Image1.Picture = LoadPicture(App.Path & "\..\Data\" & flname)
FrmPic.Image1.Refresh
FrmPic.Show
FrmAvi.Hide
ElseIf OptPicAvi(1).Value = True Then
If IsNull(Trim(objRcd.GetFieldValue("Avi"))) Then
FrmPic.Hide
FrmAvi.Hide
Exit Sub
End If
'读取AVI名称
flname = Trim(objRcd.GetFieldValue("Avi"))
'装载AVI并显示
FrmAvi.MdPlayer.Open (App.Path & "\..\Data\" & flname)
FrmAvi.Show
FrmPic.Hide
End If
Set objpnt = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -