frmoutput.frm

GIS+VB开发. GIS+VB开发.

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmOutPut 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "输出地图"
   ClientHeight    =   1635
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   Icon            =   "FrmOutPut.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1635
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2760
      Top             =   480
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "保存文件"
      Filter          =   "JPG文件(*.jpg)|*.jpg|GIF文件(*.gif)|*.gif|BMP文件(*.bmp)|*.bmp|PNG文件(*.png)|*.png|WMF文件(*.wmf)|*.wmf|TIF文件(*.tif)|*.tif"
   End
   Begin VB.CommandButton Command4 
      Caption         =   "退出"
      Height          =   495
      Left            =   3840
      TabIndex        =   7
      Top             =   1080
      Width           =   735
   End
   Begin VB.CommandButton Command3 
      Caption         =   "输出地图"
      Height          =   495
      Left            =   2400
      TabIndex        =   6
      Top             =   1080
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "0"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   1
      EndProperty
      Height          =   270
      Left            =   1560
      MaxLength       =   2
      TabIndex        =   4
      Text            =   "1"
      Top             =   435
      Width           =   495
   End
   Begin VB.CommandButton Command2 
      Caption         =   "将地图复制到剪贴板"
      Height          =   495
      Left            =   240
      TabIndex        =   3
      Top             =   1080
      Width           =   1935
   End
   Begin VB.CheckBox Check1 
      Caption         =   "突出显示所选择地物"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   720
      Width           =   1935
   End
   Begin VB.CommandButton Command1 
      Caption         =   "选择路径"
      Height          =   495
      Left            =   3600
      TabIndex        =   1
      Top             =   420
      Width           =   975
   End
   Begin VB.TextBox Text1 
      Height          =   255
      Left            =   120
      Locked          =   -1  'True
      TabIndex        =   0
      Text            =   "文件路径"
      Top             =   120
      Width           =   4455
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "放大倍数(数字)："
      Height          =   180
      Left            =   120
      TabIndex        =   5
      Top             =   480
      Width           =   1440
   End
End
Attribute VB_Name = "FrmOutPut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim NewFileName As String

Private Sub Check1_Click()
If Check1.Value = 0 Then FrmMain.MyMap.ExportSelection = False
If Check1.Value = 1 Then FrmMain.MyMap.ExportSelection = True
End Sub

Private Sub Command1_Click()
Dim filename As String
On Error Resume Next
CommonDialog1.filename = NewFileName
CommonDialog1.CancelError = True
CommonDialog1.Flags = &H2
CommonDialog1.Action = 2
If Err.Number = 32755 Then Exit Sub
filename = CommonDialog1.filename
NewFileName = CommonDialog1.FileTitle
If Right(filename, 1) = ")" Then filename = Left(filename, Len(filename) - 1)
If Right(NewFileName, 1) = ")" Then NewFileName = Left(NewFileName, Len(NewFileName) - 1)
Text1.Text = filename
End Sub

Private Sub Command2_Click()
FrmMain.MyMap.ExportMap "clipboard", miFormatBMP
End Sub

Private Sub Command3_Click()
Dim FormatStr As String, inta As Integer
On Error Resume Next
Select Case Right(Text1.Text, 4)
Case ".jpg"
  FormatStr = miFormatJPEG
Case ".gif"
  FormatStr = miFormatGIF
Case ".bmp"
  FormatStr = miFormatBMP
Case ".png"
  FormatStr = miFormatPNG
Case ".wmf"
  FormatStr = miFormatWMF
Case ".tif"
  FormatStr = miFormatTIF
Case Else
  MsgBox "输出文件路径有错误，请先选择路径"
  Exit Sub
End Select
inta = Val(Text2.Text)
FrmMain.MyMap.ExportMap Text1.Text, FormatStr, FrmMain.MyMap.MapPaperWidth * inta, FrmMain.MyMap.MapPaperHeight * inta
Unload Me
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Form_Load()
FrmMain.MyMap.MapUnit = miUnitMillimeter
If FrmMain.MyMap.ExportSelection Then Check1.Value = 1
End Sub

Private Sub Text1_Change()
Text1.ToolTipText = Text1.Text
End Sub

Private Sub Text2_LostFocus()
If Val(Text2.Text) <= 0 Or Val(Text2.Text) > 20 Then
MsgBox "请输入一个大于0小于20的数"
Text2.SetFocus
Exit Sub
End If
End Sub