📄 frmoutput.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"
Begin VB.Form FrmMain
BorderStyle = 3 'Fixed Dialog
Caption = "地图输出"
ClientHeight = 6090
ClientLeft = 45
ClientTop = 330
ClientWidth = 9360
Icon = "FrmOutput.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6090
ScaleWidth = 9360
StartUpPosition = 2 'CenterScreen
Begin SuperMapLib.SuperWorkspace SuperWorkspace1
Left = 2100
Top = 1140
_Version = 327682
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
End
Begin SuperMapLib.SuperMap SuperMap1
Height = 5415
Left = 60
TabIndex = 6
Top = 600
Width = 4515
_Version = 327682
_ExtentX = 7964
_ExtentY = 9551
_StockProps = 160
End
Begin VB.CommandButton Command1
Caption = "缩小"
Height = 375
Left = 960
TabIndex = 5
Top = 60
Width = 795
End
Begin MSComDlg.CommonDialog dlg
Left = 6840
Top = 1470
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton btnPan
Caption = "漫游"
Height = 375
Left = 2040
TabIndex = 4
Top = 60
Width = 1125
End
Begin VB.CommandButton btnViewEntire
Caption = "全幅"
Height = 375
Left = 3180
TabIndex = 3
Top = 60
Width = 1125
End
Begin VB.CommandButton btnZoomFree
Caption = "放大"
Height = 375
Left = 75
TabIndex = 2
Top = 60
Width = 795
End
Begin VB.ComboBox Combo1
Height = 315
Left = 6000
Style = 2 'Dropdown List
TabIndex = 1
Top = 60
Width = 3255
End
Begin VB.CommandButton btnOutPut
Caption = "输出"
Height = 375
Left = 4680
TabIndex = 0
Top = 60
Width = 1125
End
Begin SuperMapLib.SuperMap SuperMap2
Height = 5415
Left = 4680
TabIndex = 8
Top = 600
Width = 4515
_Version = 327682
_ExtentX = 7964
_ExtentY = 9551
_StockProps = 160
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
Height = 5415
Left = 4740
ScaleHeight = 5355
ScaleWidth = 4455
TabIndex = 7
Top = 600
Width = 4515
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================Sueprmap Objects示范工程说明=======================================
'
'功能简介：示范输出地图窗口中的Map到另一个控件或输出为文件的功能
'所用控件：Supermap1控件和Superworkspace1控件
'所用数据：..\Data\World\目录下的World.sdb和World.sdd两个文件
'操作说明：
' 1、单击"放大"、"缩小"、"平移"、"全幅"按钮，可以缩放和平移地图，以备输出。
' 2、单击"输出"，可以把左侧地图窗口中的地图输出到下拉列表框中的列出的地方。
' 1) "输出到另一个控件"：可以把地图输出到另一个有HDC属性的控件上，如PictureBox。
' 2) "输出为数据集"：将当前可视范围内的地图输出为影像数据集，影像数据集输出时的横向象素为800
' 3) "输出为图形文件"：可以把地图输出为.bmp,jpg或png等格式的图形文件。
' 4) "输出到打印机"：可以把地图打印出来。
'
'
'===================================Sueprmap Objects示范工程说明结束=====================================
Option Explicit
Private Sub btnOutPut_Click()
Dim objDs As soDataSource
Dim strDtName As String
Dim objDt As soDataset
Dim objFileType As seFileType
Dim objRect As soRect
If Combo1.ListIndex = 0 Then
'"输出到另一个控件上"
SuperMap2.Visible = False
Picture1.Visible = True
SuperMap1.OutputMap Picture1.hDC
Picture1.Refresh
ElseIf Combo1.ListIndex = 1 Then
'"输出为一个数据集"
Picture1.Visible = False
SuperMap2.Visible = True
Set objRect = SuperMap1.ViewBounds
Set objDs = SuperWorkspace1.Datasources("world")
If objDs Is Nothing Then
MsgBox "创建数据源文件失败！", vbInformation
Else
strDtName = Trim$(InputBox$("请输入文件名："))
If strDtName = "" Then Exit Sub
If objDs.IsAvailableDatasetName(strDtName) Then
If SuperMap1.OutputMapEx(objDs, strDtName, objRect.Width / 800, objRect) = True Then '输出为影像数据集，这里把分辨率写成固定值，实际应该根据数据的情况来定制分辨率
Set objDt = objDs.Datasets(strDtName)
If Not (objDt Is Nothing) Then
SuperMap2.Layers.RemoveAll
SuperMap2.Layers.AddDataset objDt, True
SuperMap2.ViewEntire
SuperMap2.Refresh
End If
MsgBox "输出成功！", vbInformation
Else
MsgBox "输出失败！", vbInformation
End If
Else
MsgBox "数据集名不合法，请重试！", vbCritical
Exit Sub
End If
End If
ElseIf Combo1.ListIndex = 2 Then
'"输出为文件"
With dlg
.DialogTitle = "输出文件"
.Filter = "位图文件(*.bmp)|*.bmp|JPEG文件(*.jpg)|*.jpg|PNG文件(*.png)|*.png"
.FilterIndex = 1
.ShowSave
strDtName = Trim$(.FileName)
End With
Select Case UCase(Right(strDtName, 3))
Case "BMP"
objFileType = scfBMP
Case "JPG"
objFileType = scfJPG
Case "PNG"
objFileType = scfPNG
Case Else
MsgBox "不支持此种文件格式", vbCritical
Exit Sub
End Select
If strDtName <> "" Then
If SuperMap1.OutputMapToFile(strDtName, objFileType) = True Then
MsgBox "输出成功！" & vbCrLf & "输出文件为：" & strDtName, vbInformation
Else
MsgBox "输出失败！", vbInformation
End If
End If
ElseIf Combo1.ListIndex = 3 Then
'输出到打印机
If SuperMap1.PrintMap(scbThin, False, True, True, True) = False Then
'上句代码意思为：打印细的地图边框，不打印背景(这样会忽略地图设置的背景)，显示打印对话框，使地图充满整张纸。
MsgBox "打印失败！", vbInformation
End If
End If
Set objDs = Nothing
Set objDt = Nothing
Set objRect = Nothing
End Sub
Private Sub btnZoomFree_Click()
SuperMap1.Action = scaZoomIn '自由缩放
End Sub
Private Sub btnViewEntire_Click()
SuperMap1.ViewEntire '全幅显示
End Sub
Private Sub btnPan_Click()
SuperMap1.Action = scaPan '漫游
End Sub
Private Sub Command1_Click()
SuperMap1.Action = scaZoomOut
End Sub
Private Sub Form_Load()
SuperMap1.Connect SuperWorkspace1.Handle
SuperMap2.Connect SuperWorkspace1.Handle
'添加数据集到SuperMap1
Dim objDs As soDataSource
Dim i As Integer
Set objDs = SuperWorkspace1.OpenDataSource(App.Path & "\..\Data\World\world.sdb", "world", sceSDBPlus, False)
If objDs Is Nothing Then
MsgBox "打开数据源文件错误！", vbInformation
Else
For i = 1 To objDs.Datasets.Count
SuperMap1.Layers.AddDataset objDs.Datasets(i), True
Next
End If
SuperMap1.MarginPanEnable = False
'装载选项到Combo1
With Combo1
.AddItem "输出到另一个控件"
.AddItem "输出为一个数据集"
.AddItem "输出为图形文件"
.AddItem "输出到打印机"
.ListIndex = 0
End With
SuperMap2.Visible = False
Set objDs = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
SuperMap1.Close
SuperMap1.Disconnect
SuperMap2.Close
SuperMap2.Disconnect
SuperWorkspace1.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -