frmexport.frm

一个不错的插件

  ' access to each object in the collection.  Because some exporters change their file
  ' extension based on settings (eg. SVG), we should read and sync the registry values
  ' for each exporter after it is created.
181:   Set pTempExport = pCategoryFactory.CreateNext
182:   Do While Not pTempExport Is Nothing
    On Error Resume Next
184:     Set pSettingsInRegistry = pTempExport
    On Error GoTo 0
186:     If Not pSettingsInRegistry Is Nothing Then
187:       pSettingsInRegistry.RestoreForCurrentUser "Software\ESRI\Export\ExportObjectsParams"
188:       m_ExportersCol.Add pTempExport, CStr(pTempExport.Priority)
189:     End If
190:     Set pTempExport = pCategoryFactory.CreateNext
191:   Loop
192:   Set pTempExport = Nothing

  'Run a simple sort operation on the exporters collection, sorting by the exporter
  ' Priority property.  This property is primarily used only for determining the order in
  ' which the exporters are listed in the dialog listbox control.
197:   iHighest = -4294967296#
  Dim j As Integer
199:   Do While m_ExportersCol.count > 0
200:     For i = 1 To m_ExportersCol.count
201:       Set pTempExport = m_ExportersCol(i)
202:       If pTempExport.Priority > iHighest Then
203:         iHighest = pTempExport.Priority
204:       End If
205:     Next
206:     Set pTempExport = m_ExportersCol(CStr(iHighest))
207:     TempExportersCol.Add pTempExport, CStr(pTempExport.Priority)
208:     m_ExportersCol.Remove CStr(iHighest)
209:     iHighest = -4294967296#
210:   Loop
211:   Set m_ExportersCol = TempExportersCol
212:   Set TempExportersCol = Nothing
  
  'Populate the SaveAsType combo box.  VB combo box controls provide the ItemData property, in
  ' which the user to store a data value of type long.  Each value will be associated with each
  ' string entry in the list.  Assign the value of the Priority property to ItemData, so we
  ' can grab it at a later point to tie an exporter object to the selected string entry.
218:   For i = 1 To m_ExportersCol.count
219:     Set pTempExport = m_ExportersCol.Item(i)
220:     Debug.Print pTempExport.Name & ": " & pTempExport.Priority
221:     If pTempExport.Filter <> "" Then
222:       Me.cboSaveAsType.AddItem Split(pTempExport.Filter, "|")(0)
223:       cboSaveAsType.ItemData(cboSaveAsType.NewIndex) = pTempExport.Priority
224:     End If
225:   Next
  
  
  ' get the last used export type from the registry.
229:   If GetRegistryValue(HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "LastExporter", REG_SZ) <> "" Then _
    sLastUsedExporterName = GetRegistryValue(HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "LastExporter", REG_SZ)
  
232:   For i = 1 To m_ExportersCol.count
233:     Set pTempExport = m_ExportersCol.Item(i)
234:     If pTempExport.Name = sLastUsedExporterName Then
235:       Debug.Print pTempExport.Name & ": " & pTempExport.Priority
236:       lLastUsedExporterPriority = pTempExport.Priority
237:     End If
238:   Next
  
240:   For i = 0 To Me.cboSaveAsType.ListCount - 1
241:     If Me.cboSaveAsType.ItemData(i) = lLastUsedExporterPriority Then
242:         Me.cboSaveAsType.ListIndex = i
243:     End If
244:   Next
  
246:   If Me.cboSaveAsType.ListIndex = -1 Then
247:     Me.cboSaveAsType.ListIndex = 0
248:   End If
  
250:   Set pTempExport = Nothing

  'assign the last used export path to m_sPath.  Get the value from the registry.
253:   If GetRegistryValue(HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "WorkingDirectory", REG_SZ) <> "" Then _
    m_sPath = GetRegistryValue(HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "WorkingDirectory", REG_SZ)
255:   If Right(m_sPath, 1) <> "\" Then _
    m_sPath = m_sPath & "\"
    

259:   m_sFileNameRoot = Left(GetMxdName(), Len(GetMxdName()) - 4)
  
  ' Call the InitExporter procedure to QI the m_pExport onto the currently selected exporter class
262:   InitExporter
  
  Exit Sub
ErrorHand:
266:   MsgBox "InitializeTheForm - " & Erl & " - " & Err.Description
  
End Sub


Private Sub InitExporter()
On Error GoTo ErrorHand
  'Set the interface pointer for the global IExport variable.  The SaveAsType combo box's
  ' ItemData property will return the Priority value that we assigned in the Form_Load event.
  ' Use it as a key to return an exporter object from m_ExportersCol.
276:   Set m_pExport = m_ExportersCol(CStr(cboSaveAsType.ItemData(cboSaveAsType.ListIndex)))
  
  ' Build the file extension string and change the textbox string accordingly.  Resist
  '  temptation to set the exporter object's ExportFileName property here... better to
  '  do that step at the time of the export operation so it will accurately reflect any
  '  changes the user may make to the textbox contents.
282:   m_sFileExtension = Split(Split(cboSaveAsType.Text, "(")(1), ")")(0)
283:   m_sFileExtension = Right(m_sFileExtension, Len(m_sFileExtension) - 1)
  
285:   txtFilename.Text = m_sPath & m_sFileNameRoot & m_sFileExtension
  
  Exit Sub
ErrorHand:
289:   MsgBox "InitExporter - " & Erl & " - " & Err.Description
End Sub


Private Sub cboSaveAsType_Click()
  
295:   InitExporter
  
End Sub


Private Sub cmdOptions_Click()
  On Error GoTo ErrorHand

  'Set the Export property of the ExportPropDlg form, and then show the form modally.  You cannot
  ' show the ExportPropDlg form without first setting this property.
  'As users interact with the form, the properties of the assigned exporter object will change
  ' in real-time. When the form ExportPropDlg is dismissed, the exporter object will reflect any
  ' changes the user may have made.
308:   Set frmExportPropDlg.Export = m_pExport
309:   frmExportPropDlg.Show vbModal, Me
  
311:   Set frmExportPropDlg.Export = Nothing
312:   Unload frmExportPropDlg
  
  'The ExportSVG class has a Compression property that changes the value of the Filter property,
  ' and we must syncronize our file extension to account for the possible change.
316:   If TypeOf m_pExport Is IExportSVG Then
317:     cboSaveAsType.List(cboSaveAsType.ListIndex) = Split(m_pExport.Filter, "|")(0)
318:     m_sPath = GetPathFromPathAndFilename(txtFilename)
319:     m_sFileExtension = Split(Split(cboSaveAsType.Text, "(")(1), ")")(0)
320:     m_sFileExtension = Right(m_sFileExtension, Len(m_sFileExtension) - 1)
321:     txtFilename.Text = m_sPath & m_sFileNameRoot & m_sFileExtension
322:   End If
        
  Exit Sub
ErrorHand:
326:   MsgBox "cmdOptions_Click - " & Erl & " - " & Err.Description
End Sub


Private Sub txtFilename_Change()
331:   m_sFileNameRoot = GetRootNameFromPath(txtFilename)
332:   m_sPath = GetPathFromPathAndFilename(txtFilename)
End Sub

Private Sub txtFileName_GotFocus()
336:   txtFilename.SelStart = 0
337:   txtFilename.SelLength = Len(txtFilename.Text)
End Sub


Private Sub cmdExport_Click()
On Error GoTo ErrorHand:
  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
  Dim pOutputRasterSettings As IOutputRasterSettings
  Dim iPrevOutputImageQuality As Long
  
353:   If Me.txtFilename.Text = "" Then
354:     MsgBox "You have not typed in a valid path!!!"
    Exit Sub
356:   End If
  
  Dim bValid As Boolean
359:   bValid = CheckForValidPath(Me.txtFilename.Text)
    
361:   If bValid = False Then
362:     MsgBox "You have not typed in a valid path!!!"
    Exit Sub
364:   End If

  '***Need to make sure it's a valid path
  
368:   Set pMouse = New MouseCursor
369:   pMouse.SetCursor 2

371:   Set pMxDoc = m_pApp.Document
372:   sFileName = m_sPath & m_sFileNameRoot
373:   sFileExt = m_sFileExtension
    
375:   Set pExport = m_pExport
        
377:   If pExport Is Nothing Then
378:     MsgBox "No export object!!!"
    Exit Sub
380:   End If
   
382:   If GetRegistryValue(HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "WorkingDirectory", REG_SZ) <> "" Then
383:     SetRegistryValue HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "WorkingDirectory", REG_SZ, m_sPath
384:   End If
   
386:   If GetRegistryValue(HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "LastExporter", REG_SZ) <> "" Then
387:     SetRegistryValue HKEY_CURRENT_USER, "Software\ESRI\Export\ExportDlg", "LastExporter", REG_SZ, pExport.Name
388:   End If
  
  'Switch to the Layout view if we are not already there
391:   If Not TypeOf pMxDoc.ActiveView Is IPageLayout Then
392:     Set pMxDoc.ActiveView = pMxDoc.PageLayout
393:   End If

395:   Set pActiveView = pMxDoc.ActiveView
'  pActiveView.ScreenDisplay.DisplayTransformation.ZoomResolution = False
  'Need to include code here to create a collection of all of the map pages that you can
  'then loop through and print.
  Dim PagesToExport As Collection
  Dim i As Long
  Dim pMapPage As IDSMapPage, pSeriesOpts As IDSMapSeriesOptions
  Dim ExportFrame As tagRECT, pSeriesOpts2 As IDSMapSeriesOptions2
  Dim hdc As Long
  Dim dpi As Integer
  Dim sExportFile As String
406:   Set PagesToExport = New Collection
407:   Set pSeriesOpts = m_pMapSeries
408:   Set pSeriesOpts2 = pSeriesOpts
  
410:   If Not m_pMapPage Is Nothing Then
411:       PagesToExport.Add m_pMapPage
412:   End If
  
414:   Set pOutputRasterSettings = pActiveView.ScreenDisplay.DisplayTransformation
415:   iPrevOutputImageQuality = pOutputRasterSettings.ResampleRatio
  
417:   If Not m_pMapSeries Is Nothing And m_pMapPage Is Nothing And m_pMapBook Is Nothing Then
418:     If Me.optAll.value = True Then
419:       For i = 0 To m_pMapSeries.PageCount - 1
420:         If Me.chkDisabled.value = 1 Then
421:           If m_pMapSeries.Page(i).EnablePage Then
422:             PagesToExport.Add m_pMapSeries.Page(i)
423:           End If
424:          Else
425:             PagesToExport.Add m_pMapSeries.Page(i)
426:         End If
427:       Next i
428:     ElseIf Me.optPages.value = True Then
      'parse out the pages to export
430:       If chkDisabled.value = 1 Then
431:         Set PagesToExport = ParseOutPages(Me.txtPages.Text, m_pMapSeries, True)
432:       Else
433:         Set PagesToExport = ParseOutPages(Me.txtPages.Text, m_pMapSeries, False)
434:       End If
      If PagesToExport.count = 0 Then Exit Sub
436:     End If
437:   End If
  
439:   If PagesToExport.count > 0 Then
440:     If pSeriesOpts2.ClipData > 0 Then
441:       g_bClipFlag = True
442:     End If
443:     If pSeriesOpts.RotateFrame Then
444:       g_bRotateFlag = True
445:     End If
446:     If pSeriesOpts.LabelNeighbors Then
447:       g_bLabelNeighbors = True
448:     End If
449:     For i = 1 To PagesToExport.count
450:       Set pMapPage = PagesToExport.Item(i)
451:       pMapPage.DrawPage pMxDoc, m_pMapSeries, False
          
453:       sExportFile = sFileName & "_" & pMapPage.PageName & sFileExt
454:       lblStatus.Caption = "Exporting to " & m_sFileNameRoot & "_" & pMapPage.PageName & sFileExt & " ..."
455:       SetupToExport pExport, dpi, ExportFrame, pActiveView, sExportFile
      
      'Do the export
458:       hdc = pExport.StartExporting
459:         pActiveView.Output hdc, pExport.Resolution, ExportFrame, Nothing, Nothing
460:         pMapPage.LastOutputted = Format(Date, "mm/dd/yyyy")
461:       pExport.FinishExporting
462:       pExport.Cleanup
463:     Next i
464:   End If
            
466:   If Not m_pMapBook Is Nothing Then
    Dim pMapSeries As IDSMapSeries
    Dim count As Long
469:     For i = 0 To m_pMapBook.ContentCount - 1
470:       Set PagesToExport = New Collection
471:       Set pMapSeries = m_pMapBook.ContentItem(i)
472:       Set pSeriesOpts = pMapSeries
    
474:       For count = 0 To pMapSeries.PageCount - 1
475:         If Me.chkDisabled.value = 1 Then
476:           If pMapSeries.Page(count).EnablePage Then
477:             PagesToExport.Add pMapSeries.Page(count)
478:           End If
479:         Else
480:             PagesToExport.Add pMapSeries.Page(count)
481:         End If
482:       Next count
        
484:       If pSeriesOpts2.ClipData > 0 Then
485:         g_bClipFlag = True
486:       End If
487:       If pSeriesOpts.RotateFrame Then
488:         g_bRotateFlag = True
489:       End If
490:       If pSeriesOpts.LabelNeighbors Then
491:         g_bLabelNeighbors = True
492:       End If
493:       For count = 1 To PagesToExport.count
        'now do export
495:         Set pMapPage = PagesToExport.Item(count)
496:         pMapPage.DrawPage pMxDoc, pMapSeries, False
      
498:         sExportFile = sFileName & "_series_" & i & "_" & pMapPage.PageName & sFileExt
 
500:         lblStatus.Caption = "Exporting to " & m_sFileNameRoot & "_series_" & i & "_" & pMapPage.PageName & sFileExt
501:         SetupToExport pExport, pExport.Resolution, ExportFrame, pActiveView, sExportFile
          
        'Do the export
504:         hdc = pExport.StartExporting
505:           pActiveView.Output hdc, pExport.Resolution, ExportFrame, Nothing, Nothing
506:           pMapPage.LastOutputted = Format(Date, "mm/dd/yyyy")
507:         pExport.FinishExporting
508:         pExport.Cleanup
509:       Next count
510:     Next i
511:   End If

'  pActiveView.ScreenDisplay.DisplayTransformation.ZoomResolution = True