📄 frmmapseries.frm
字号:
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 = 855
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 2006 ESRI
'
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
'
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
'
' See use restrictions at /arcgis/developerkit/userestrictions.
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()
26: tvwMapBook.Nodes.Clear
' tvwMapBook.Nodes.Add , , "MapBook", "Map Book (0 pages)", 1
28: tvwMapBook.Nodes.Add , , "MapBook", "Map Book", 1
29: m_bNodeFlag = True
30: m_bClickFlag = False
31: m_bLabelingChanged = False
32: Set m_pExportFrame = New ModelessFrame
End Sub
Private Sub Form_Terminate()
36: Set m_pExportFrame = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
40: 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
47: Set pMapBook = GetMapBookExtension(m_pApp)
If pMapBook Is Nothing Then Exit Sub
Select Case Index
Case 0 'Add Map Series
52: If pMapBook.ContentCount > 0 Then
53: MsgBox "You must remove the existing Map Series before adding another."
Exit Sub
55: End If
'Call the wizard for setting parameters and creating the series
58: Set frmMapSeriesWiz.m_pApp = m_pApp
59: frmMapSeriesWiz.Show vbModal
Case 1 'Separator
Case 2 'Print Map Book
62: ShowPrinterDialog m_pApp, , pMapBook
' pMapBook.PrintBook
Case 3 'Export Map Book
65: ShowExporterDialog m_pApp, , pMapBook
' pMapBook.ExportBook
67: End Select
Exit Sub
ErrHand:
71: 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
80: Set pMapBook = GetMapBookExtension(m_pApp)
If pMapBook Is Nothing Then Exit Sub
83: Set pMapSeries = pMapBook.ContentItem(0)
84: Set pSeriesOpts = pMapSeries
85: Set pSeriesOpts2 = pSeriesOpts
86: lPage = m_pCurrentNode.Tag
Select Case Index
Case 0 'View Page
89: Set pMapPage = pMapSeries.Page(lPage)
90: pMapPage.DrawPage m_pApp.Document, pMapSeries, True
91: If pSeriesOpts2.ClipData > 0 Then
92: g_bClipFlag = True
93: End If
94: If pSeriesOpts.RotateFrame Then
95: g_bRotateFlag = True
96: End If
97: If pSeriesOpts.LabelNeighbors Then
98: g_bLabelNeighbors = True
99: End If
Case 1 'Separator
Case 2 'Delete Page
'Remove the page, then update the tags on all subsequent pages
103: pMapSeries.RemovePage lPage
104: tvwMapBook.Nodes.Remove lPage + 3
105: RenumberPages pMapSeries
Case 3 'Separator
Case 4 'Disable Page
'Get the index number from the tag of the node
109: pMapSeries.Page(lPage).EnablePage = Not pMapSeries.Page(lPage).EnablePage
110: If pMapSeries.Page(lPage).EnablePage Then
111: m_pCurrentNode.Image = 5
112: Else
113: m_pCurrentNode.Image = 6
114: End If
Case 5 'Separator
Case 6 'Print Page
117: ShowPrinterDialog m_pApp, pMapSeries, pMapSeries.Page(lPage)
Case 7 'Export Page
119: ShowExporterDialog m_pApp, pMapSeries, pMapSeries.Page(lPage)
120: End Select
Exit Sub
ErrHand:
124: 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
136: Set pMapBook = GetMapBookExtension(m_pApp)
If pMapBook Is Nothing Then Exit Sub
139: Set pMapSeries = pMapBook.ContentItem(0)
140: Set pSeriesProps = pMapSeries
141: Set pDoc = m_pApp.Document
Select Case Index
Case 0 'Select Pages
144: Set frmSelectPages.m_pApp = m_pApp
145: frmSelectPages.Show vbModal
Case 1 'Separator
Case 2 'Tag as Date
148: bFlag = TagItem(pDoc, "DSMAPBOOK - DATE", "")
149: If Not bFlag Then
150: MsgBox "You must have one Text Element selected in the Page Layout for tagging!!!"
151: End If
Case 3 'Tag as Title
153: bFlag = TagItem(pDoc, "DSMAPBOOK - TITLE", "")
154: If Not bFlag Then
155: MsgBox "You must have one Text Element selected in the Page Layout for tagging!!!"
156: End If
Case 4 'Tag as Page Number
158: bFlag = TagItem(pDoc, "DSMAPBOOK - PAGENUMBER", "")
159: If Not bFlag Then
160: MsgBox "You must have one Text Element selected in the Page Layout for tagging!!!"
161: End If
Case 5 'Tag with Index Layer Field...
'Find the data frame
164: Set pMap = FindDataFrame(pDoc, pSeriesProps.DataFrameName)
165: If pMap Is Nothing Then
166: MsgBox "Could not find map in mnuSeries_Click routine!!!"
Exit Sub
168: End If
'Find the Index layer
170: Set pIndexLayer = FindLayer(pSeriesProps.IndexLayerName, pMap)
171: If pIndexLayer Is Nothing Then
172: MsgBox "Could not find index layer in mnuSeries_Click routine!!!"
Exit Sub
174: End If
176: frmTagIndexField.InitializeList pIndexLayer.FeatureClass.Fields
177: frmTagIndexField.Show vbModal
'Exit sub if Cancel was selected
180: If frmTagIndexField.m_bCancel Then
181: Unload frmTagIndexField
Exit Sub
183: End If
185: lIndex = frmTagIndexField.lstFields.ListIndex
186: If lIndex >= 0 Then
187: sTemp = frmTagIndexField.lstFields.List(lIndex)
188: Else
189: MsgBox "You did not pick a field to tag with!!!"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -