frmmapseries.frm

使用VB和ArcObject结合的程序

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmMapSeries 
   BackColor       =   &H80000004&
   Caption         =   "Form1"
   ClientHeight    =   5055
   ClientLeft      =   165
   ClientTop       =   885
   ClientWidth     =   4275
   LinkTopic       =   "Form1"
   ScaleHeight     =   5055
   ScaleWidth      =   4275
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox picBook 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   4335
      Left            =   150
      ScaleHeight     =   4335
      ScaleWidth      =   3885
      TabIndex        =   1
      Top             =   630
      Width           =   3885
      Begin MSComctlLib.TreeView tvwMapBook 
         Height          =   4725
         Left            =   0
         TabIndex        =   2
         Top             =   0
         Width           =   3855
         _ExtentX        =   6800
         _ExtentY        =   8334
         _Version        =   393217
         Indentation     =   44
         LabelEdit       =   1
         LineStyle       =   1
         Sorted          =   -1  'True
         Style           =   3
         FullRowSelect   =   -1  'True
         SingleSel       =   -1  'True
         ImageList       =   "ImageList1"
         Appearance      =   1
      End
   End
   Begin VB.ListBox lstSorter 
      Height          =   1230
      Left            =   2790
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   3420
      Visible         =   0   'False
      Width           =   1485
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   33
      ImageHeight     =   15
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   8
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":062E
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":0C5C
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":11EE
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":1780
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":1BF2
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":2064
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMapSeries.frx":2656
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuHeadingBook 
      Caption         =   "Book"
      Begin VB.Menu mnuBook 
         Caption         =   "Add Map Series..."
         Index           =   0
      End
      Begin VB.Menu mnuBook 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuBook 
         Caption         =   "Print Map Book..."
         Index           =   2
      End
      Begin VB.Menu mnuBook 
         Caption         =   "Export Map Book..."
         Index           =   3
      End
   End
   Begin VB.Menu mnuHeadingSeries 
      Caption         =   "Series"
      Begin VB.Menu mnuSeries 
         Caption         =   "Select/Enable Pages..."
         Index           =   0
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Tag as Date"
         Index           =   2
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Tag as Title"
         Index           =   3
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Tag as Page Number"
         Index           =   4
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Tag with Index Layer Field..."
         Index           =   5
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Clear Tag for Selected"
         Index           =   6
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "-"
         Index           =   7
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Delete Series"
         Index           =   8
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Delete Disabled Pages"
         Index           =   9
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "-"
         Index           =   10
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Disable Series"
         Index           =   11
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "-"
         Index           =   12
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Print Series..."
         Index           =   13
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Export Series..."
         Index           =   14
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Create Series Index..."
         Index           =   15
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "-"
         Index           =   16
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Series Properties..."
         Index           =   17
      End
      Begin VB.Menu mnuSeries 
         Caption         =   "Page Properties..."
         Index           =   18
      End
   End
   Begin VB.Menu mnuHeadingPage 
      Caption         =   "Page"
      Begin VB.Menu mnuPage 
         Caption         =   "View Page"
         Index           =   0
      End
      Begin VB.Menu mnuPage 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuPage 
         Caption         =   "Delete Page"
         Index           =   2
      End
      Begin VB.Menu mnuPage 
         Caption         =   "-"
         Index           =   3
      End
      Begin VB.Menu mnuPage 
         Caption         =   "Disable Page"
         Index           =   4
      End
      Begin VB.Menu mnuPage 
         Caption         =   "-"
         Index           =   5
      End
      Begin VB.Menu mnuPage 
         Caption         =   "Print Page..."
         Index           =   6
      End
      Begin VB.Menu mnuPage 
         Caption         =   "Export Page..."
         Index           =   7
      End
   End
End
Attribute VB_Name = "frmMapSeries"
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]

Option Explicit

Public m_pApp As IApplication
Private m_lXClick As Single
Private m_lYClick As Single
Private m_lButton As Single
Private m_pCurrentNode As Node
Private m_bNodeFlag As Boolean
Private m_bClickFlag As Boolean
Private m_bLabelingChanged As Boolean
Private m_pExportFrame As IModelessFrame

Private Sub Form_Load()
14:   tvwMapBook.Nodes.Clear
'  tvwMapBook.Nodes.Add , , "MapBook", "Map Book (0 pages)", 1
16:   tvwMapBook.Nodes.Add , , "MapBook", "Map Book", 1
17:   m_bNodeFlag = True
18:   m_bClickFlag = False
19:   m_bLabelingChanged = False
20:   Set m_pExportFrame = New ModelessFrame
End Sub

Private Sub Form_Terminate()
24:   Set m_pExportFrame = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
28:   Set m_pExportFrame = Nothing
End Sub

Private Sub mnuBook_Click(Index As Integer)
On Error GoTo ErrHand:
  Dim pMapBook As IDSMapBook
  'Check to see if a MapSeries already exists
35:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
  Select Case Index
  Case 0  'Add Map Series
40:     If pMapBook.ContentCount > 0 Then
41:       MsgBox "You must remove the existing Map Series before adding another."
      Exit Sub
43:     End If
  
    'Call the wizard for setting parameters and creating the series
46:     Set frmMapSeriesWiz.m_pApp = m_pApp
47:     frmMapSeriesWiz.Show vbModal
  Case 1  'Separator
  Case 2  'Print Map Book
50:     ShowPrinterDialog m_pApp, , pMapBook
'    pMapBook.PrintBook
  Case 3  'Export Map Book
53:     ShowExporterDialog m_pApp, , pMapBook
'    pMapBook.ExportBook
55:   End Select
  
  Exit Sub
ErrHand:
59:   MsgBox "mnuBook_Click - " & Err.Description
End Sub

Private Sub mnuPage_Click(Index As Integer)
On Error GoTo ErrHand:
  Dim pMapBook As IDSMapBook, pMapSeries As IDSMapSeries
  Dim lPage As Long, sText As String, lPos As Long, pMapPage As IDSMapPage
  Dim pSeriesOpts As IDSMapSeriesOptions, pSeriesOpts2 As IDSMapSeriesOptions2
  'Check to see if a MapSeries already exists
68:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
71:   Set pMapSeries = pMapBook.ContentItem(0)
72:   Set pSeriesOpts = pMapSeries
73:   Set pSeriesOpts2 = pSeriesOpts
74:   lPage = m_pCurrentNode.Tag
  Select Case Index
  Case 0  'View Page
77:     Set pMapPage = pMapSeries.Page(lPage)
78:     pMapPage.DrawPage m_pApp.Document, pMapSeries, True
79:     If pSeriesOpts2.ClipData > 0 Then
80:       g_bClipFlag = True
81:     End If
82:     If pSeriesOpts.RotateFrame Then
83:       g_bRotateFlag = True
84:     End If
85:     If pSeriesOpts.LabelNeighbors Then
86:       g_bLabelNeighbors = True
87:     End If
  Case 1  'Separator
  Case 2  'Delete Page
    'Remove the page, then update the tags on all subsequent pages
91:     pMapSeries.RemovePage lPage
92:     tvwMapBook.Nodes.Remove lPage + 3
93:     RenumberPages pMapSeries
  Case 3  'Separator
  Case 4  'Disable Page
    'Get the index number from the tag of the node
97:     pMapSeries.Page(lPage).EnablePage = Not pMapSeries.Page(lPage).EnablePage
98:     If pMapSeries.Page(lPage).EnablePage Then
99:       m_pCurrentNode.Image = 5
100:     Else
101:       m_pCurrentNode.Image = 6
102:     End If
  Case 5  'Separator
  Case 6  'Print Page
105:     ShowPrinterDialog m_pApp, pMapSeries, pMapSeries.Page(lPage)
  Case 7  'Export Page
107:     ShowExporterDialog m_pApp, pMapSeries, pMapSeries.Page(lPage)
108:   End Select
  
  Exit Sub
ErrHand:
112:   MsgBox "mnuPage_Click - " & Erl & " - " & Err.Description
End Sub

Private Sub mnuSeries_Click(Index As Integer)
On Error GoTo ErrHand:
  Dim pMapBook As IDSMapBook, pMapSeries As IDSMapSeries, pSeriesProps As IDSMapSeriesProps
  Dim lLoop As Long, pDoc As IMxDocument, pActive As IActiveView, bFlag As Boolean
  Dim pGraphicsCont As IGraphicsContainer, pElemProps As IElementProperties
  Dim pEnv As IEnvelope, pElem As IElement, pTextElement As ITextElement, pEnv2 As IEnvelope
  Dim pGraphicsContSel As IGraphicsContainerSelect, pMap As IMap
  Dim pIndexLayer As IFeatureLayer, lIndex As Long, sName As String, sTemp As String
  'Check to see if a MapSeries already exists
124:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
127:   Set pMapSeries = pMapBook.ContentItem(0)
128:   Set pSeriesProps = pMapSeries
129:   Set pDoc = m_pApp.Document
  Select Case Index
  Case 0  'Select Pages
132:     Set frmSelectPages.m_pApp = m_pApp
133:     frmSelectPages.Show vbModal
  Case 1  'Separator
  Case 2  'Tag as Date
136:     bFlag = TagItem(pDoc, "DSMAPBOOK - DATE", "")
137:     If Not bFlag Then
138:       MsgBox "You must have one Text Element selected in the Page Layout for tagging!!!"
139:     End If
  Case 3  'Tag as Title
141:     bFlag = TagItem(pDoc, "DSMAPBOOK - TITLE", "")
142:     If Not bFlag Then
143:       MsgBox "You must have one Text Element selected in the Page Layout for tagging!!!"
144:     End If
  Case 4  'Tag as Page Number
146:     bFlag = TagItem(pDoc, "DSMAPBOOK - PAGENUMBER", "")
147:     If Not bFlag Then
148:       MsgBox "You must have one Text Element selected in the Page Layout for tagging!!!"
149:     End If
  Case 5  'Tag with Index Layer Field...
    'Find the data frame
152:     Set pMap = FindDataFrame(pDoc, pSeriesProps.DataFrameName)
153:     If pMap Is Nothing Then
154:       MsgBox "Could not find map in mnuSeries_Click routine!!!"
      Exit Sub
156:     End If
    'Find the Index layer
158:     Set pIndexLayer = FindLayer(pSeriesProps.IndexLayerName, pMap)
159:     If pIndexLayer Is Nothing Then
160:       MsgBox "Could not find index layer in mnuSeries_Click routine!!!"
      Exit Sub
162:     End If
  
164:     frmTagIndexField.InitializeList pIndexLayer.FeatureClass.Fields
165:     frmTagIndexField.Show vbModal
    
    'Exit sub if Cancel was selected
168:     If frmTagIndexField.m_bCancel Then
169:       Unload frmTagIndexField