frmmapseries.frm

一个不错的插件

190:       Unload frmTagIndexField
      Exit Sub
192:     End If
193:     Unload frmTagIndexField
    
195:     lIndex = InStr(1, sTemp, " - ")
196:     sName = Mid(sTemp, 1, lIndex - 1)
197:     bFlag = TagItem(pDoc, "DSMAPBOOK - EXTRAITEM", sName)
198:     If Not bFlag Then
199:       MsgBox "You must have one Text Element selected in the Page Layout for tagging!!!"
200:     End If
  Case 6  'Clear Tag for selected
202:     Set pGraphicsCont = pDoc.PageLayout
203:     Set pGraphicsContSel = pDoc.PageLayout
204:     For lLoop = 0 To pGraphicsContSel.ElementSelectionCount - 1
205:       Set pElemProps = pGraphicsContSel.SelectedElement(lLoop)
206:       If TypeOf pElemProps Is ITextElement Then
207:         pElemProps.Name = ""
208:         pElemProps.Type = ""
209:         pGraphicsCont.UpdateElement pTextElement
210:       End If
211:     Next lLoop
  Case 7  'Separator
  Case 8  'Delete Series
214:     Set pActive = pDoc.FocusMap
215:     TurnOffClipping pMapSeries, m_pApp
216:     Set pMapSeries = Nothing
217:     pMapBook.RemoveContent 0
218:     tvwMapBook.Nodes.Clear
219:     tvwMapBook.Nodes.Add , , "MapBook", "Map Book", 1
220:     RemoveIndicators m_pApp
221:     pActive.Refresh
  Case 9  'Delete Disabled pages
    'Loop in reverse order so we remove pages as we work up.  Doing it this way makes
    'sure numbering isn't messed up when a page/node is removed.
225:     For lLoop = pMapSeries.PageCount - 1 To 0 Step -1
226:       If Not pMapSeries.Page(lLoop).EnablePage Then
227:         pMapSeries.RemovePage lLoop
228:         tvwMapBook.Nodes.Remove lLoop + 3
229:       End If
230:     Next lLoop
231:     RenumberPages pMapSeries
  Case 10  'Separator
  Case 11  'Disable Series
    'Get the index number from the tag of the node
235:     pMapSeries.EnableSeries = Not pMapSeries.EnableSeries
236:     If pMapSeries.EnableSeries Then
237:       m_pCurrentNode.Image = 3
238:     Else
239:       m_pCurrentNode.Image = 4
240:     End If
  Case 12  'Separator
  Case 13  'Print Series
243:     ShowPrinterDialog m_pApp, pMapSeries, Nothing
'    pMapSeries.PrintSeries
  Case 14  'Export Series
246:     ShowExporterDialog m_pApp, pMapSeries, Nothing
'    pMapSeries.ExportSeries
  Case 15
249:     Set frmCreateIndex.m_pApp = m_pApp
250:     frmCreateIndex.Show vbModal
  Case 16  'Separator
  Case 17  'Series Properties...
253:     Set frmSeriesProperties.m_pApp = m_pApp
254:     frmSeriesProperties.Show vbModal
  Case 18  'Page Properties...
256:     Set frmPageProperties.m_pApp = m_pApp
257:     frmPageProperties.Show vbModal
258:   End Select
  
  Exit Sub
ErrHand:
262:   MsgBox "mnuSeries_Click - " & Erl & " - " & Err.Description
End Sub

Private Function TagItem(pDoc As IMxDocument, sName As String, sType As String) As Boolean
On Error GoTo ErrHand:
  Dim bFlag As Boolean, pGraphicsCont As IGraphicsContainer, pActive As IActiveView
  Dim pElemProps As IElementProperties, pElem As IElement, pTextElement As ITextElement
  Dim pEnv2 As IEnvelope, pGraphicsContSel As IGraphicsContainerSelect, pEnv As IEnvelope
  
271:   Set pGraphicsCont = pDoc.PageLayout
272:   Set pGraphicsContSel = pDoc.PageLayout
273:   bFlag = False
274:   If pGraphicsContSel.ElementSelectionCount = 1 Then
275:     Set pElemProps = pGraphicsContSel.SelectedElement(0)
276:     If TypeOf pElemProps Is ITextElement Then
277:       Set pActive = pDoc.PageLayout
278:       pElemProps.Name = sName
279:       Set pElem = pElemProps
280:       Set pEnv = New Envelope
281:       pElem.QueryBounds pActive.ScreenDisplay, pEnv
282:       Set pTextElement = pElemProps
      Select Case sName
      Case "DSMAPBOOK - DATE"
285:         pTextElement.Text = Format(Date, "mmm dd, yyyy")
      Case "DSMAPBOOK - TITLE"
287:         pTextElement.Text = "Title String"
      Case "DSMAPBOOK - PAGENUMBER"
289:         pTextElement.Text = "PAGE #"
      Case "DSMAPBOOK - EXTRAITEM"
291:         pTextElement.Text = sType
292:         pElemProps.Type = sType
293:       End Select
294:       pGraphicsCont.UpdateElement pTextElement
295:       Set pEnv2 = New Envelope
296:       pElem.QueryBounds pActive.ScreenDisplay, pEnv2
297:       pEnv.Union pEnv2
298:       pActive.PartialRefresh esriViewGraphics, Nothing, pEnv
299:       bFlag = True
300:     End If
301:   End If
  
303:   TagItem = bFlag

  Exit Function
ErrHand:
307:   MsgBox "TagItem - " & Erl & " - " & Err.Description
308:   TagItem = bFlag
End Function

Private Sub RenumberPages(pMapSeries As IDSMapSeries)
On Error GoTo ErrHand:
'Routine for renumber the pages after one is removed
  Dim lLoop As Long, pNode As Node, sName As String, lPageNumber As Long
  Dim pPage As IDSMapPage, pSeriesProps As IDSMapSeriesProps
316:   Set pSeriesProps = pMapSeries
317:   For lLoop = 0 To pMapSeries.PageCount - 1
318:     lPageNumber = lLoop + pSeriesProps.StartNumber
319:     Set pPage = pMapSeries.Page(lLoop)
320:     Set pNode = tvwMapBook.Nodes.Item(lLoop + 3)
321:     sName = Mid(pNode.Key, 2)
322:     pNode.Tag = lLoop
323:     pNode.Key = "a" & sName
324:     pNode.Text = lPageNumber & " - " & sName
325:     pPage.PageNumber = lPageNumber
326:   Next lLoop
327:   tvwMapBook.Refresh
  
  Exit Sub
ErrHand:
331:   MsgBox "RenumberPages - " & Erl & " - " & Err.Description
End Sub

Private Sub picBook_Resize()
335:   tvwMapBook.Width = picBook.Width
336:   tvwMapBook.Height = picBook.Height
End Sub

Private Sub tvwMapBook_DblClick()
On Error GoTo ErrHand:
  Dim lPos As String, sText As String, pMapPage As IDSMapPage, lPage As Long
  Dim pSeriesOpts As IDSMapSeriesOptions, pSeriesOpts2 As IDSMapSeriesOptions2
  Dim pMapBook As IDSMapBook, pMapSeries As IDSMapSeries
344:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
347:   Set pMapSeries = pMapBook.ContentItem(0)
348:   Set pSeriesOpts = pMapSeries
349:   Set pSeriesOpts2 = pSeriesOpts
  
  'There is no NodeDoubleClick event, so we have to use the DblClick event on the control
  'and check to make sure we are over a node.  In the event of a doubleclick on a node,
  'the order of events being fired are NodeClick, MouseUp, Click, DblClick, MouseUp.  To
  'make sure the doubleclick occurred over a node, we can set a flag in the NodeClick event
  'and then disable it in the MouseUp event after the Click event.
  If Not m_bNodeFlag Then Exit Sub
  
  Select Case m_pCurrentNode.Image
  Case 5, 6   'Enable and not Enabled options for a map page
360:     If m_lXClick > 1320 Then
361:       If m_lButton = 1 Then
362:         lPage = m_pCurrentNode.Tag
363:         Set pMapPage = pMapSeries.Page(lPage)
364:         pMapPage.DrawPage m_pApp.Document, pMapSeries, True
365:         If pSeriesOpts2.ClipData > 0 Then
366:           g_bClipFlag = True
367:         End If
368:         If pSeriesOpts.RotateFrame Then
369:           g_bRotateFlag = True
370:         End If
371:         If pSeriesOpts.LabelNeighbors Then
372:           g_bLabelNeighbors = True
373:         End If
374:       End If
375:     End If
376:   End Select

  Exit Sub
ErrHand:
380:   MsgBox "twvMapBook_NodeClick - " & Err.Description
End Sub

Private Sub tvwMapBook_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo ErrHand:
385:   m_lXClick = X
386:   m_lYClick = Y
  
388:   m_lButton = Button
  
  Exit Sub
ErrHand:
392:   MsgBox "tvwMapBook_MouseDown - " & Err.Description
End Sub

Private Sub tvwMapBook_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo ErrHand:
  If Not m_bClickFlag Then Exit Sub
398:   m_bClickFlag = False
399:   m_bNodeFlag = False
  
  Exit Sub
ErrHand:
403:   MsgBox "tvwMapBook_MouseUp - " & Err.Description
End Sub

Private Sub tvwMapBook_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo ErrHand:
  Dim lLoop As Long, pUID As New UID, lImage As Long
  Dim pItem As ICommandItem, lPos As Long, sText As String
  Dim pMapBook As IDSMapBook, pMapSeries As IDSMapSeries
  Dim lPage As Long
  'Check to see if a MapSeries already exists
413:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
416:   Set pMapSeries = pMapBook.ContentItem(0)
  
418:   Set m_pCurrentNode = Node
  Select Case Node.Image
  Case 1, 2   'Enable and not Enabled options for a map book
421:     If m_lXClick < 180 Then
422:       If Node.Image = 1 Then
423:         Node.Image = 2
424:         pMapBook.EnableBook = False
'        tvwMapBook.Nodes.Item("MapSeries").Image = 4
'        UpdatePages False
427:       Else
428:         Node.Image = 1
429:         pMapBook.EnableBook = True
'        tvwMapBook.Nodes.Item("MapSeries").Image = 3
'        UpdatePages True
432:       End If
433:     Else
434:       If m_lButton = 2 Then
435:         PopupMenu mnuHeadingBook
436:       End If
437:     End If
  Case 3, 4   'Enable and not Enabled options for a map series
439:     If m_lXClick > 510 And m_lXClick < 760 Then
440:       If Node.Image = 3 Then
441:         Node.Image = 4
442:         pMapSeries.EnableSeries = False
'        UpdatePages False
444:       Else
445:         Node.Image = 3
446:         pMapSeries.EnableSeries = True
'        UpdatePages True
448:       End If
449:     Else
450:       If m_lButton = 2 Then
451:         If Node.Image = 3 Then
452:           mnuSeries(11).Caption = "Disable Series"
453:         Else
454:           mnuSeries(11).Caption = "Enable Series"
455:         End If
456:         PopupMenu mnuHeadingSeries
457:       End If
458:     End If
  Case 5, 6   'Enable and not Enabled options for a map page
460:     If m_lXClick > 1320 Then
461:       If m_lButton = 2 Then
462:         If Node.Image = 5 Then
463:           mnuPage(4).Caption = "Disable Page"
464:         Else
465:           mnuPage(4).Caption = "Enable Page"
466:         End If
467:         PopupMenu mnuHeadingPage
468:       End If
469:     ElseIf m_lXClick > 1080 And m_lXClick <= 1320 Then
470:       lPage = Node.Tag
471:       If Node.Image = 5 Then
472:         Node.Image = 6
473:         pMapSeries.Page(lPage).EnablePage = False
474:       Else
475:         Node.Image = 5
476:         pMapSeries.Page(lPage).EnablePage = True
477:       End If
478:     End If
479:   End Select

  Exit Sub
ErrHand:
483:   MsgBox "twvMapBook_NodeClick - " & Err.Description
End Sub

Private Sub UpdatePages(bEnableFlag As Boolean)
On Error GoTo ErrHand:
  Dim lLoop As Long, pNode As Node
489:   For lLoop = 2 To tvwMapBook.Nodes.count
490:     Set pNode = tvwMapBook.Nodes.Item(lLoop)
491:     If pNode.Image = 5 Or pNode.Image = 6 Then
492:       If bEnableFlag = True Then
493:         pNode.Image = 5
494:       Else
495:         pNode.Image = 6
496:       End If
497:     End If
498:   Next lLoop

  Exit Sub
ErrHand:
502:   MsgBox "UpdatePages - " & Err.Description
End Sub

Public Sub ShowPrinterDialog(pMxApp As IMxApplication, Optional pMapSeries As IDSMapSeries, Optional pPrintMaterial As IUnknown)
  On Error GoTo ErrorHandler
  Dim pFrm As frmPrint

  Dim pPrinter As IPrinter
  Dim pApp As IApplication
  Dim iNumPages As Integer
  Dim pPage As IPage
  Dim pDoc As IMxDocument
  Dim pLayout As IPageLayout
  
516:   Set pPrinter = pMxApp.Printer
517:   If pPrinter Is Nothing Then
518:     MsgBox "You must have at least one printer defined before using this command!!!"
    Exit Sub
520:   End If
  
522:   Set pApp = pMxApp
523:   Set pFrm = New frmPrint
524:   pFrm.Application = pApp
525:   pFrm.ExportFrame = m_pExportFrame
526:   m_pExportFrame.Create pFrm
  
528:   Set pDoc = pApp.Document
529:   Set pLayout = pDoc.PageLayout
530:   Set pPage = pLayout.Page
          
532:   pPage.PrinterPageCount pPrinter, 0, iNumPages
  
534:   pFrm.txtTo.Text = iNumPages
      
536:   pFrm.lblName.Caption = pPrinter.Paper.PrinterName
537:   pFrm.lblType.Caption = pPrinter.DriverName
538:   If TypeOf pPrinter Is IPsPrinter Then
539:     pFrm.chkPrintToFile.Enabled = True
540:   Else
541:     pFrm.chkPrintToFile.value = 0
542:     pFrm.chkPrintToFile.Enabled = False
543:   End If
  'If pprintmaterial is nothing then it means you are printing a map series
  
546:   If pPrintMaterial Is Nothing Then
547:       pFrm.aDSMapSeries = pMapSeries
548:       pFrm.optPrintCurrentPage.Enabled = False
549:       m_pExportFrame.Visible = True
      Exit Sub
551:   End If
  
553:   If TypeOf pPrintMaterial Is IDSMapBook Then
554:       pFrm.aDSMapBook = pPrintMaterial
555:       pFrm.optPrintCurrentPage.Enabled = False
556:       pFrm.optPrintPages.Enabled = False
557:       pFrm.txtPrintPages.Enabled = False
558:   ElseIf TypeOf pPrintMaterial Is IDSMapPage Then
559:       pFrm.aDSMapPage = pPrintMaterial
560:       pFrm.aDSMapSeries = pMapSeries
561:       pFrm.optPrintCurrentPage.value = True
562:       pFrm.optPrintAll.Enabled = False
563:       pFrm.optPrintPages.Enabled = False
564:       pFrm.txtPrintPages.Enabled = False
565:   End If
566:   m_pExportFrame.Visible = True
567:   Set pPrintMaterial = Nothing
    
  Exit Sub
ErrorHandler:
571:   MsgBox "ShowPrinterDialog - " & Err.Description
End Sub

Public Sub ShowExporterDialog(pApp As IApplication, Optional pMapSeries As IDSMapSeries, Optional pExportMaterial As IUnknown)
  On Error GoTo ErrorHandler
  Dim pFrm As frmExport
    
578:   Set pFrm = New frmExport
579:   pFrm.Application = pApp
580:   pFrm.ExportFrame = m_pExportFrame
581:   m_pExportFrame.Create pFrm
  
583:   If pExportMaterial Is Nothing Then
584:       pFrm.aDSMapSeries = pMapSeries
585:       pFrm.optCurrentPage.Enabled = False
586:       pFrm.InitializeTheForm
587:       m_pExportFrame.Visible = True
      Exit Sub
589:   End If
  
591:   If TypeOf pExportMaterial Is IDSMapBook Then
592:     pFrm.aDSMapBook = pExportMaterial
593:     pFrm.optCurrentPage.Enabled = False
594:     pFrm.optPages.Enabled = False
595:     pFrm.txtPages.Enabled = False
596:     pFrm.InitializeTheForm
597:   ElseIf TypeOf pExportMaterial Is IDSMapPage Then
598:     pFrm.aDSMapPage = pExportMaterial
599:     pFrm.aDSMapSeries = pMapSeries
600:     pFrm.optCurrentPage.value = True
601:     pFrm.optAll.Enabled = False
602:     pFrm.optPages.Enabled = False
603:     pFrm.txtPages.Enabled = False
604:     pFrm.InitializeTheForm
605:   End If
606:   m_pExportFrame.Visible = True
607:   Set pExportMaterial = Nothing

  Exit Sub
ErrorHandler:
611:   MsgBox "ShowExporterDialog - " & Err.Description
End Sub