frmexport.frm

使用VB和ArcObject结合的程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmExport 
   Caption         =   "Export"
   ClientHeight    =   4020
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5595
   LinkTopic       =   "Form1"
   ScaleHeight     =   4020
   ScaleWidth      =   5595
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtPath 
      Height          =   315
      Left            =   840
      TabIndex        =   12
      Top             =   30
      Width           =   3375
   End
   Begin VB.CommandButton cmdBrowse 
      Caption         =   "Browse..."
      Height          =   375
      Left            =   4440
      TabIndex        =   11
      Top             =   0
      Width           =   855
   End
   Begin VB.ComboBox cmbExportType 
      Height          =   315
      Left            =   1200
      TabIndex        =   10
      Top             =   870
      Width           =   3015
   End
   Begin VB.CommandButton cmdOptions 
      Caption         =   "Options..."
      Height          =   375
      Left            =   4440
      TabIndex        =   9
      Top             =   840
      Width           =   855
   End
   Begin VB.CommandButton cmdExport 
      Caption         =   "&OK"
      Height          =   375
      Left            =   3870
      TabIndex        =   8
      Top             =   3300
      Width           =   735
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   4770
      TabIndex        =   7
      Top             =   3300
      Width           =   735
   End
   Begin VB.Frame fraPageRange 
      Caption         =   "Page range"
      Height          =   2295
      Left            =   90
      TabIndex        =   0
      Top             =   1380
      Width           =   3615
      Begin VB.OptionButton optAll 
         Caption         =   "All"
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   360
         Value           =   -1  'True
         Width           =   615
      End
      Begin VB.OptionButton optCurrentPage 
         Caption         =   "Current page"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   720
         Width           =   1215
      End
      Begin VB.OptionButton optPages 
         Caption         =   "Pages:"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   1080
         Width           =   855
      End
      Begin VB.TextBox txtPages 
         Height          =   375
         Left            =   1200
         TabIndex        =   2
         Top             =   1020
         Width           =   1575
      End
      Begin VB.CheckBox chkDisabled 
         Caption         =   "Don't output disabled pages"
         Height          =   255
         Left            =   240
         TabIndex        =   1
         Top             =   1920
         Width           =   2295
      End
      Begin VB.Label lblDescription 
         Caption         =   "Enter page number and/ or page ranges separated by commas.  For example, 1,2,5-12"
         Height          =   375
         Left            =   240
         TabIndex        =   6
         Top             =   1440
         Width           =   3255
      End
   End
   Begin MSComDlg.CommonDialog dlgExport 
      Left            =   4800
      Top             =   1380
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "Export"
   End
   Begin VB.Label Label1 
      Caption         =   "The name of the page will be appended to the specified file name."
      Height          =   225
      Left            =   300
      TabIndex        =   16
      Top             =   420
      Width           =   4755
   End
   Begin VB.Label lblStatus 
      Height          =   225
      Left            =   75
      TabIndex        =   15
      Top             =   3735
      Width           =   5445
   End
   Begin VB.Label lblExportTo 
      Caption         =   "Export to:"
      Height          =   255
      Left            =   60
      TabIndex        =   14
      Top             =   60
      Width           =   735
   End
   Begin VB.Label lblExportType 
      Caption         =   "Save as Type:"
      Height          =   255
      Left            =   60
      TabIndex        =   13
      Top             =   900
      Width           =   1095
   End
End
Attribute VB_Name = "frmExport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 1995-2004 ESRI

' All rights reserved under the copyright laws of the United States.

' You may freely redistribute and use this sample code, with or without modification.

' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF
' SUCH DAMAGE.

' For additional information contact: Environmental Systems Research Institute, Inc.

' Attn: Contracts Dept.

' 380 New York Street

' Redlands, California, U.S.A. 92373

' Email: [e-mail]

Private m_pMapPage As IDSMapPage
Private m_pMapSeries As IDSMapSeries
Private m_pMapBook As IDSMapBook
Private m_pApp As IApplication
Private m_pExport As IExport
Private m_pExportFrame As IModelessFrame

Public Property Get aDSMapPage() As IDSMapPage
9:     Set aDSMapPage = m_pMapPage
End Property

Public Property Let aDSMapPage(ByVal pMapPage As IDSMapPage)
13:     Set m_pMapPage = pMapPage
End Property

Public Property Let ExportFrame(ByVal pExportFrame As IModelessFrame)
17:     Set m_pExportFrame = pExportFrame
End Property

Public Property Get aDSMapSeries() As IDSMapSeries
21:     Set aDSMapSeries = m_pMapSeries
End Property

Public Property Let aDSMapSeries(ByVal pMapSeries As IDSMapSeries)
25:     Set m_pMapSeries = pMapSeries
End Property

Public Property Get aDSMapBook() As IDSMapBook
29:     Set aDSMapBook = m_pMapBook
End Property

Public Property Let aDSMapBook(ByVal pMapBook As IDSMapBook)
33:     Set m_pMapBook = pMapBook
End Property

Public Property Get Application() As IApplication
37:     Set Application = m_pApp
End Property

Public Property Let Application(ByVal pApp As IApplication)
41:     Set m_pApp = pApp
End Property

Public Sub SetupDialog()
  On Error GoTo ErrorHandler
  
  Exit Sub
ErrorHandler:
49:   MsgBox "SetupDialog - " & Err.Description
End Sub


Private Sub cmbExportType_Click()

55: Set m_pExport = Nothing

If Me.txtPath.Text = "" Then Exit Sub

Dim sExt As String
60:     sExt = Me.cmbExportType.Text

62:     ChangeFileExtension sExt

End Sub

Private Sub cmdBrowse_Click()
Dim sFileExt As String
Dim sFileName As String

'    Me.dlgExport.Filter = "EMF (*.emf)|*.emf|CGM (*.cgm)|*.cgm|EPS (*.eps)|*.eps|AI (*.ai)|*.ai|PDF (*.pdf)|*.pdf|BMP (*.bmp)|*.bmp|TIFF (*.tif)|*.tif|JPEG (*.jpg)|*.jpg"
    
72:     Me.dlgExport.Filter = "BMP (*.bmp)|*.bmp|EPS (*.eps)|*.eps|JPEG (*.jpg)|*.jpg|PDF (*.pdf)|*.pdf|TIFF (*.tif)|*.tif"
   
74:     If Me.cmbExportType.ListIndex <> -1 Then
75:         Me.dlgExport.FilterIndex = Me.cmbExportType.ListIndex + 1
76:     Else
77:         Me.dlgExport.FilterIndex = 4
78:     End If
    
80:     Me.dlgExport.DialogTitle = "Export"
    
'    Me.Hide
83:     m_pExportFrame.Visible = False
    
85:     Me.dlgExport.ShowSave
    
87:     If Me.dlgExport.FileName = "" Then
88:         Me.Show
        Exit Sub
90:     Else
91:         sFileName = Me.dlgExport.FileName
92:     End If
    
94:      sFileExt = Right(sFileName, 3)
     
    Select Case sFileExt
        Case "emf"
98:             Me.cmbExportType.Text = "EMF (*.emf)"
'        Case "cgm"
'            Me.cmbExportType.Text = "CGM (*.cgm)"
        Case "eps"
102:             Me.cmbExportType.Text = "EPS (*.eps)"
        Case ".ai"
104:             Me.cmbExportType.Text = "AI (*.ai)"
        Case "pdf"
106:             Me.cmbExportType.Text = "PDF (*.pdf)"
        Case "bmp"
108:             Me.cmbExportType.Text = "BMP (*.bmp)"
        Case "tif"
110:             Me.cmbExportType.Text = "TIFF (*.tif)"
        Case "jpg"
112:             Me.cmbExportType.Text = "JPEG (*.jpg)"
113:     End Select
    
115:     Me.txtPath.Text = sFileName
    
'   Me.Show
118:   m_pExportFrame.Visible = True
  
End Sub

Private Sub cmdCancel_Click()
123:     m_pExportFrame.Visible = False
124:     Unload Me
End Sub

Private Sub cmdExport_Click()
On Error GoTo ErrHand:
  Dim sFileExt As String
  Dim pExport As IExport
  Dim pJpegExport As IExportJPEG
  Dim sFileName As String
  Dim pActiveView As IActiveView
  Dim pMxDoc As IMxDocument
  Dim pMouse As IMouseCursor
  
137:   If Me.txtPath.Text = "" Then
138:     MsgBox "You have not typed in a valid path!!!"
    Exit Sub
140:   End If
  
  Dim bValid As Boolean
143:   bValid = CheckForValidPath(Me.txtPath.Text)