frmprint.frm

来自「使用VB和ArcObject结合的程序」· FRM 代码 · 共 800 行 · 第 1/2 页

32:     Set aDSMapPage = m_pMapPage
End Property

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

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

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

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

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

Private Sub cmdOK_Click()
On Error GoTo ErrorHandler

  Dim pAView As IActiveView
  Dim pPrinter As IPrinter
  Dim pMxApp As IMxApplication
  Dim pMxDoc As IMxDocument
  Dim pLayout As IPageLayout
  Dim iNumPages As Integer
  Dim pPage As IPage
  Dim pMouse As IMouseCursor
  
67:   Set pMouse = New MouseCursor
68:   pMouse.SetCursor 2

70:   Set pMxApp = m_pApp
71:   Set pPrinter = pMxApp.Printer
72:   Set pMxDoc = m_pApp.Document
73:   Set pLayout = pMxDoc.PageLayout
74:   Set pPage = pLayout.Page
  
76:   If Me.chkPrintToFile.Value = 1 Then
'    If UCase(pPrinter.FileExtension) = "PS" Then
78:       Me.dlgPrint.Filter = "Postscript Files (*.ps,*.eps)|*.ps,*.eps"
'    Else
'      Me.dlgPrint.Filter = UCase(pPrinter.FileExtension) & " (*." & LCase(pPrinter.FileExtension) & ")" & "|*." & LCase(pPrinter.FileExtension)
'    End If
    
83:     Me.dlgPrint.DialogTitle = "Print to File"
'    Me.Hide
85:     m_pExportFrame.Visible = False
86:     Me.dlgPrint.ShowSave
    
    Dim sFileName As String, sPrefix As String, sExt As String, sSplit() As String
    
90:     sFileName = Me.dlgPrint.FileName
91:     If sFileName <> "" Then
92:       If InStr(1, sFileName, ".", vbTextCompare) > 0 Then
93:         sSplit = Split(sFileName, ".", , vbTextCompare)
94:         sPrefix = sSplit(0)
95:         sExt = sSplit(1)
96:       Else
97:         sPrefix = sFileName
98:         sExt = "ps"
99:         sFileName = sFileName & ".ps"
100:       End If
101:     Else
102:       MsgBox "Please specify a file name for the page(s)"
'      Me.Show
104:       m_pExportFrame.Visible = True
      Exit Sub
106:     End If
107:   End If
  
109:   If Me.optTile.Value = True Then
110:       pPage.PageToPrinterMapping = esriPageMappingTile
111:   ElseIf Me.optScale = True Then
112:       pPage.PageToPrinterMapping = esriPageMappingScale
113:   ElseIf Me.optProceed.Value = True Then
114:       pPage.PageToPrinterMapping = esriPageMappingCrop
115:   End If
  
117:   pPrinter.Paper.Orientation = pLayout.Page.Orientation
  
  Dim rectDeviceBounds As tagRECT
  Dim pVisBounds As IEnvelope
  Dim hdc As Long
  Dim lDPI As Long
  Dim devFrameEnvelope As IEnvelope
  Dim iCurrentPage As Integer, pSeriesOpts As IDSMapSeriesOptions
  Dim pSeriesOpts2 As IDSMapSeriesOptions2
  
  'Need to include code here to create a collection of all of the map pages that you can
  'then loop through and print.
  Dim PagesToPrint As Collection
  Dim i As Long
  Dim pMapPage As IDSMapPage
  Dim numPages As Long
  Dim a As Long
  
135:   Set PagesToPrint = New Collection
  
137:   If Not m_pMapPage Is Nothing Then
138:       PagesToPrint.Add m_pMapPage
139:   End If
  
141:   If m_pMapPage Is Nothing And m_pMapBook Is Nothing Then
142:     If frmPrint.optPrintAll.Value = True Then
143:       For i = 0 To m_pMapSeries.PageCount - 1
144:         If chkDisabled.Value = 1 Then
145:           If m_pMapSeries.Page(i).EnablePage Then
146:             PagesToPrint.Add m_pMapSeries.Page(i)
147:           End If
148:         Else
149:           PagesToPrint.Add m_pMapSeries.Page(i)
150:         End If
151:       Next i
152:     ElseIf frmPrint.optPrintPages.Value = True Then
      'parse out the pages to print
154:       If chkDisabled.Value = 1 Then
155:         Set PagesToPrint = ParseOutPages(Me.txtPrintPages.Text, m_pMapSeries, True)
156:       Else
157:         Set PagesToPrint = ParseOutPages(Me.txtPrintPages.Text, m_pMapSeries, False)
158:       End If
      If PagesToPrint.count = 0 Then Exit Sub
160:     End If
161:   End If
      
163:   numPages = CLng(Me.txtCopies.Text)
  
165:   If PagesToPrint.count > 0 Then
166:     Set pSeriesOpts = m_pMapSeries
167:     Set pSeriesOpts2 = pSeriesOpts
168:     If pSeriesOpts2.ClipData > 0 Then
169:       g_bClipFlag = True
170:     End If
171:     If pSeriesOpts.RotateFrame Then
172:       g_bRotateFlag = True
173:     End If
174:     If pSeriesOpts.LabelNeighbors Then
175:       g_bLabelNeighbors = True
176:     End If
177:     For i = 1 To PagesToPrint.count
178:       Set pMapPage = PagesToPrint.Item(i)
179:       pMapPage.DrawPage pMxDoc, m_pMapSeries, False
180:       CheckNumberOfPages pPage, pPrinter, iNumPages
181:       lblPrintStatus.Caption = "Printing page " & pMapPage.PageName & " ..."
        
183:       For iCurrentPage = 1 To iNumPages
184:         SetupToPrint pPrinter, pPage, iCurrentPage, lDPI, rectDeviceBounds, pVisBounds, devFrameEnvelope
185:         If Me.chkPrintToFile.Value = 1 Then
186:           If pPage.PageToPrinterMapping = esriPageMappingTile Then
187:             pPrinter.PrintToFile = sPrefix & "_" & pMapPage.PageName & "_" & iCurrentPage & "." & sExt
188:           Else
189:             pPrinter.PrintToFile = sPrefix & "_" & pMapPage.PageName & "." & sExt
190:           End If
191:         End If
192:         For a = 1 To numPages
193:           hdc = pPrinter.StartPrinting(devFrameEnvelope, 0)
194:             pMxDoc.ActiveView.Output hdc, lDPI, rectDeviceBounds, pVisBounds, Nothing
195:             pMapPage.LastOutputted = Format(Date, "mm/dd/yyyy")
196:           pPrinter.FinishPrinting
197:         Next a
198:       Next iCurrentPage
199:     Next i
200:   End If
  
202:   If Not m_pMapBook Is Nothing Then
    Dim pSeriesCount As Long
    Dim MapSeriesColl As Collection
    Dim pMapSeries As IDSMapSeries
    Dim count As Long
    
208:     pSeriesCount = m_pMapBook.ContentCount
    
210:     Set MapSeriesColl = New Collection
    
212:     For i = 0 To pSeriesCount - 1
213:         MapSeriesColl.Add m_pMapBook.ContentItem(i)
214:     Next i

    If MapSeriesColl.count = 0 Then Exit Sub
    
218:     For i = 1 To MapSeriesColl.count
219:       Set PagesToPrint = New Collection
220:       Set pMapSeries = MapSeriesColl.Item(i)
221:       Set pSeriesOpts = pMapSeries
222:       Set pSeriesOpts2 = pSeriesOpts
      
224:       If pSeriesOpts2.ClipData > 0 Then
225:         g_bClipFlag = True
226:       End If
227:       If pSeriesOpts.RotateFrame Then
228:         g_bRotateFlag = True
229:       End If
230:       If pSeriesOpts.LabelNeighbors Then
231:         g_bLabelNeighbors = True
232:       End If
        
234:       For count = 0 To pMapSeries.PageCount - 1
235:         If chkDisabled.Value = 1 Then
236:           If pMapSeries.Page(count).EnablePage Then
237:             PagesToPrint.Add pMapSeries.Page(count)
238:           End If
239:         Else
240:           PagesToPrint.Add pMapSeries.Page(count)
241:         End If
242:       Next count
      
244:       For count = 1 To PagesToPrint.count
      'now do printing
246:         Set pMapPage = PagesToPrint.Item(count)
247:         pMapPage.DrawPage pMxDoc, pMapSeries, False
        
249:         CheckNumberOfPages pPage, pPrinter, iNumPages
250:         lblPrintStatus.Caption = "Printing page " & pMapPage.PageName & " ..."
            
252:         For iCurrentPage = 1 To iNumPages
253:           SetupToPrint pPrinter, pPage, iCurrentPage, lDPI, rectDeviceBounds, pVisBounds, devFrameEnvelope
254:           If Me.chkPrintToFile.Value = 1 Then
255:             If pPage.PageToPrinterMapping = esriPageMappingTile Then
256:               pPrinter.PrintToFile = sPrefix & "_" & pMapPage.PageName & "_" & iCurrentPage & "." & sExt
257:             Else
258:               pPrinter.PrintToFile = sPrefix & "_" & pMapPage.PageName & "." & sExt
259:             End If
260:           End If
261:           For a = 1 To numPages
262:             hdc = pPrinter.StartPrinting(devFrameEnvelope, 0)
263:               pMxDoc.ActiveView.Output hdc, lDPI, rectDeviceBounds, pVisBounds, Nothing
264:               pMapPage.LastOutputted = Format(Date, "mm/dd/yyyy")
265:             pPrinter.FinishPrinting
266:           Next a
267:         Next iCurrentPage
      
269:       Next count
            
271:     Next i
272:   End If
                                   
274:   lblPrintStatus.Caption = ""
275:   Set m_pMapBook = Nothing
276:   Set m_pMapPage = Nothing
277:   Set m_pMapSeries = Nothing
278:   m_pExportFrame.Visible = False
279:   Unload Me

  Exit Sub
ErrorHandler:
283:   lblPrintStatus.Caption = ""
284:   MsgBox "cmdOK_Click - " & Err.Description
End Sub

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

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

Private Sub cmdSetup_Click()
296:   If (Not m_pApp.IsDialogVisible(esriMxDlgPageSetup)) Then
    Dim bDialog As Boolean
    Dim pPrinter As IPrinter
    Dim pMxApp As IMxApplication
300:     m_pApp.ShowDialog esriMxDlgPageSetup, True
    
302:     m_pExportFrame.Visible = False
'    Me.Hide
304:     bDialog = True
    
306:     While bDialog = True
307:         bDialog = m_pApp.IsDialogVisible(esriMxDlgPageSetup)
308:         DoEvents
        
'            Sleep 1
    
312:     Wend
    
314:     Set pMxApp = m_pApp
315:     Set pPrinter = pMxApp.Printer
316:     frmPrint.lblName.Caption = pPrinter.Paper.PrinterName
317:     frmPrint.lblType.Caption = pPrinter.DriverName
318:     If TypeOf pPrinter Is IPsPrinter Then
319:       Me.chkPrintToFile.Enabled = True
320:     Else
321:       Me.chkPrintToFile.Value = 0
322:       Me.chkPrintToFile.Enabled = False
323:     End If
'    Me.Show
325:     m_pExportFrame.Visible = True
326:   End If
End Sub

Private Sub Form_Load()
330:   chkDisabled.Value = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
334:     Set m_pApp = Nothing
335:     Set m_pMapPage = Nothing
336:     Set m_pMapSeries = Nothing
337:     Set m_pMapBook = Nothing
338:     Set m_pExportFrame = Nothing
End Sub

Private Sub optProceed_Click()
342:     If optProceed.Value = True Then
343:         Me.fraTileOptions.Enabled = False
344:     End If
End Sub

Private Sub optScale_Click()
348:     If optScale.Value = True Then
349:         Me.fraTileOptions.Enabled = False
350:     End If
End Sub

Private Sub optTile_Click()
354:     If optTile.Value = True Then
355:         Me.fraTileOptions.Enabled = True
356:         Me.optTileAll.Value = True
357:     Else
358:         Me.fraTileOptions.Enabled = False
359:     End If
End Sub

Public Sub SetupToPrint(pPrinter As IPrinter, pPage As IPage, iCurrentPage As Integer, ByRef lDPI As Long, ByRef rectDeviceBounds As tagRECT, _
ByRef pVisBounds As IEnvelope, ByRef devFrameEnvelope As IEnvelope)
On Error GoTo ErrorHandler
  Dim idpi As Integer
  Dim pDeviceBounds As IEnvelope
  Dim paperWidthInch As Double
  Dim paperHeightInch As Double

370:   idpi = pPrinter.Resolution  'dots per inch
          
372:   Set pDeviceBounds = New Envelope
              
374:   pPage.GetDeviceBounds pPrinter, iCurrentPage, 0, idpi, pDeviceBounds
               
376:   rectDeviceBounds.Left = pDeviceBounds.XMin
377:   rectDeviceBounds.Top = pDeviceBounds.YMin
378:   rectDeviceBounds.Right = pDeviceBounds.XMax
379:   rectDeviceBounds.bottom = pDeviceBounds.YMax
  
  'Following block added 6/19/03 to fix problem with plots being cutoff
382:   If TypeOf pPrinter Is IEmfPrinter Then
    ' For emf printers we have to remove the top and left unprintable area
    ' from device coordinates so its origin is 0,0.
    '
386:     rectDeviceBounds.Right = rectDeviceBounds.Right - rectDeviceBounds.Left
387:     rectDeviceBounds.bottom = rectDeviceBounds.bottom - rectDeviceBounds.Top
388:     rectDeviceBounds.Left = 0
389:     rectDeviceBounds.Top = 0
390:   End If
  
392:   Set pVisBounds = New Envelope
393:   pPage.GetPageBounds pPrinter, iCurrentPage, 0, pVisBounds
394:   pPrinter.QueryPaperSize paperWidthInch, paperHeightInch
395:   Set devFrameEnvelope = New Envelope
396:   devFrameEnvelope.PutCoords 0, 0, paperWidthInch * idpi, paperHeightInch * idpi
  
398:   lDPI = CLng(idpi)

  Exit Sub
ErrorHandler:
402:   MsgBox "SetupToPrint - " & Err.Description
End Sub

Public Sub CheckNumberOfPages(pPage As IPage, pPrinter As IPrinter, ByRef iNumPages As Integer)
On Error GoTo ErrorHandler
407:   pPage.PrinterPageCount pPrinter, 0, iNumPages
      
409:   If frmPrint.optTile.Value = True Then
410:     If frmPrint.optPages.Value = True Then
      Dim iPageNo As Integer
      Dim sPageNo As String
413:       sPageNo = frmPrint.txtTo.Text
      
415:       If sPageNo <> "" Then
416:           iPageNo = CInt(sPageNo)
417:       Else
          Exit Sub
419:       End If
      
421:       If iPageNo < iNumPages Then
422:           iNumPages = iPageNo
423:       End If
424:     End If
425:   End If
  
  Exit Sub
ErrorHandler:
429:   MsgBox "CheckNumberOfPages - " & Err.Description
End Sub