frmmapserieswiz.frm

一个不错的插件

         End
         Begin VB.Label lblMapSheet 
            Caption         =   "This field specifies the page name"
            Height          =   225
            Index           =   4
            Left            =   240
            TabIndex        =   13
            Top             =   960
            Width           =   2535
         End
         Begin VB.Label lblMapSheet 
            Caption         =   "Choose the index layer:"
            Height          =   225
            Index           =   3
            Left            =   240
            TabIndex        =   11
            Top             =   270
            Width           =   1725
         End
      End
      Begin VB.ComboBox cmbDetailFrame 
         Height          =   315
         Left            =   270
         Style           =   2  'Dropdown List
         TabIndex        =   9
         Top             =   1140
         Width           =   2625
      End
      Begin VB.Label Label1 
         Caption         =   $"frmMapSeriesWiz.frx":00F8
         Height          =   615
         Index           =   0
         Left            =   60
         TabIndex        =   7
         Top             =   60
         Width           =   6705
      End
      Begin VB.Label lblMapSheet 
         Caption         =   "Choose the detail data frame:"
         Height          =   225
         Index           =   0
         Left            =   30
         TabIndex        =   8
         Top             =   870
         Width           =   2235
      End
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      Index           =   1
      X1              =   120
      X2              =   6780
      Y1              =   3580
      Y2              =   3580
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      Index           =   0
      X1              =   120
      X2              =   6780
      Y1              =   3570
      Y2              =   3570
   End
End
Attribute VB_Name = "frmMapSeriesWiz"
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

Private m_iPage As Integer
Public m_pApp As IApplication
Private m_pCurrentFrame As Frame
Private m_pMap As IMap
Private m_pIndexLayer As IFeatureLayer
Private m_bFormLoad As Boolean
Private m_pTextSym As ISimpleTextSymbol

Private Sub PositionFrame(pFrame As Frame)
On Error GoTo ErrHand:

26:   If Not m_pCurrentFrame Is Nothing Then m_pCurrentFrame.Visible = False
27:   pFrame.Visible = True
28:   pFrame.Height = 3495
29:   pFrame.Width = 6825
30:   pFrame.Left = 30
31:   pFrame.Top = 30
32:   Set m_pCurrentFrame = pFrame
33:   pFrame.Visible = True
     
  Exit Sub
ErrHand:
37:   MsgBox "PositionFrame - " & Err.Description
  Exit Sub
End Sub

Private Sub chkOptions_Click(Index As Integer)
  Select Case Index
  Case 0  'Rotate
44:     If chkOptions(0).value = 0 Then
45:       cmbRotateField.Enabled = False
46:     Else
47:       cmbRotateField.Enabled = True
48:     End If
  Case 1  'Clip to outline
50:     If chkOptions(1).value = 0 Then
51:       chkOptions(3).Enabled = False
52:       chkOptions(3).value = 0
53:     Else
54:       chkOptions(3).Enabled = True
55:     End If
  Case 2  'Label neighboring tiles
57:     If chkOptions(2).value = 0 Then
58:       cmdLabelProps.Enabled = False
59:     Else
60:       cmdLabelProps.Enabled = True
61:     End If
  Case 4  'Select tile when drawing - Added 11/23/04
    
64:   End Select
End Sub

Private Sub chkSuppress_Click()
68:   If chkSuppress.value = 0 Then
69:     lstSuppressTiles.Enabled = False
70:   Else
71:     lstSuppressTiles.Enabled = True
72:   End If
End Sub

Private Sub cmbDetailFrame_Click()
On Error GoTo ErrHand:
  Dim pDoc As IMxDocument, lLoop As Long
  Dim pFeatLayer As IFeatureLayer, pGroupLayer As ICompositeLayer
  
  'Set the Next button to false
81:   cmdNext.Enabled = False
  
  'Find the selected map
84:   cmbIndexLayer.Clear
85:   If cmbDetailFrame.Text = "" Then
86:     MsgBox "No detail frame selected!!!"
    Exit Sub
88:   End If
  
90:   Set pDoc = m_pApp.Document
91:   Set m_pMap = FindDataFrame(pDoc, cmbDetailFrame.Text)
92:   If m_pMap Is Nothing Then
93:     MsgBox "Could not find detail frame!!!"
    Exit Sub
95:   End If
  
  'Populate the index layer combo
98:   lstSuppressTiles.Clear
99:   cmbIndexLayer.Clear
100:   For lLoop = 0 To m_pMap.LayerCount - 1
101:     If TypeOf m_pMap.Layer(lLoop) Is ICompositeLayer Then
102:       CompositeLayer m_pMap.Layer(lLoop)
103:     Else
104:       LayerCheck m_pMap.Layer(lLoop)
105:     End If
106:   Next lLoop
107:   If cmbIndexLayer.ListCount = 0 Then
108:     MsgBox "You need at least one polygon layer in the detail frame to serve as the index layer!!!"
109:   Else
110:     cmbIndexLayer.ListIndex = 0
111:   End If
  
  Exit Sub
ErrHand:
115:   MsgBox "cmbDetailFrame_Click - " & Err.Description
End Sub

Private Sub CompositeLayer(pCompLayer As ICompositeLayer)
On Error GoTo ErrHand:
  Dim lLoop As Long
121:   For lLoop = 0 To pCompLayer.count - 1
122:     If TypeOf pCompLayer.Layer(lLoop) Is ICompositeLayer Then
123:       CompositeLayer pCompLayer.Layer(lLoop)
124:     Else
125:       LayerCheck pCompLayer.Layer(lLoop)
126:     End If
127:   Next lLoop

  Exit Sub
ErrHand:
131:   MsgBox "CompositeLayer - " & Err.Description
End Sub

Private Sub LayerCheck(pLayer As ILayer)
On Error GoTo ErrHand:
  Dim pFeatLayer As IFeatureLayer
  
138:   If TypeOf pLayer Is IFeatureLayer Then
139:     Set pFeatLayer = pLayer
140:     If pFeatLayer.FeatureClass.ShapeType = esriGeometryPolygon Then
141:       cmbIndexLayer.AddItem pFeatLayer.Name
142:     End If
143:     lstSuppressTiles.AddItem pFeatLayer.Name
144:   End If

  Exit Sub
ErrHand:
148:   MsgBox "LayerCheck - " & Err.Description
End Sub

Private Sub cmbIndexLayer_Click()
On Error GoTo ErrHand:
  Dim lLoop As Long, pFields As IFields, pField As IField
  
  'Set the Next button to false
156:   cmdNext.Enabled = False
  
  'Find the selected layer
159:   cmbIndexField.Clear
160:   If cmbIndexLayer.Text = "" Then
161:     MsgBox "No index layer selected!!!"
    Exit Sub
163:   End If
  
165:   Set m_pIndexLayer = FindLayer(cmbIndexLayer.Text, m_pMap)
166:   If m_pIndexLayer Is Nothing Then
167:     MsgBox "Could not find specified layer!!!"
    Exit Sub
169:   End If
  
  'Populate the index layer combos
172:   Set pFields = m_pIndexLayer.FeatureClass.Fields
173:   cmbDataDriven.Clear
174:   cmbRotateField.Clear
175:   For lLoop = 0 To pFields.FieldCount - 1
    Select Case pFields.Field(lLoop).Type
    Case esriFieldTypeString
178:       cmbIndexField.AddItem pFields.Field(lLoop).Name
    Case esriFieldTypeDouble, esriFieldTypeSingle, esriFieldTypeInteger
180:       If UCase(pFields.Field(lLoop).Name) <> "SHAPE_LENGTH" And _
       UCase(pFields.Field(lLoop).Name) <> "SHAPE_AREA" Then
182:         cmbDataDriven.AddItem pFields.Field(lLoop).Name
183:         cmbRotateField.AddItem pFields.Field(lLoop).Name
184:       End If
185:     End Select
186:   Next lLoop
187:   If cmbIndexField.ListCount = 0 Then
'    MsgBox "You need at least one string field in the layer for labeling the pages!!!"
189:   Else
190:     cmbIndexField.ListIndex = 0
191:     cmdNext.Enabled = True
192:   End If
193:   If cmbDataDriven.ListCount > 0 Then
194:     cmbDataDriven.ListIndex = 0
195:     cmbRotateField.ListIndex = 0
196:     optExtent.Item(2).Enabled = True
197:     chkOptions(0).Enabled = True
198:   Else
199:     optExtent.Item(2).Enabled = False
200:     chkOptions(0).Enabled = False
201:   End If

  Exit Sub
ErrHand:
205:   MsgBox "cmbIndexField_Click - " & Err.Description
End Sub

Private Sub cmdBack_Click()
209:   m_pCurrentFrame.Visible = False
  Select Case m_iPage
  Case 2
212:     PositionFrame fraPage1
213:     m_iPage = 1
  Case 3
215:     cmdNext.Caption = "Next >"
216:     PositionFrame fraPage2
217:     m_iPage = 2
218:   End Select
219:   cmdNext.Enabled = True
End Sub

Private Sub cmdCancel_Click()
223:   Unload Me
End Sub

Private Sub cmdLabelProps_Click()
On Error GoTo ErrHand:
  Dim bChanged As Boolean, pTextSymEditor As ITextSymbolEditor
229:   Set pTextSymEditor = New TextSymbolEditor
230:   bChanged = pTextSymEditor.EditTextSymbol(m_pTextSym, m_pApp.hwnd)
231:   Me.SetFocus
  
  Exit Sub
ErrHand:
235:   MsgBox "cmdLabelProps_Click - " & Err.Description
End Sub

Private Sub cmdNext_Click()
On Error GoTo ErrHand:
  Dim pMapSeries As IDSMapSeries
241:   m_pCurrentFrame.Visible = False
242:   cmdBack.Enabled = True
  Select Case m_iPage
  Case 1  'Done with date frame and index layer
245:     CheckForSelected    'Check index layer to see if there are selected features
246:     PositionFrame fraPage2
247:     m_iPage = 2
  Case 2  'Done with tile specification
249:     PositionFrame fraPage3
250:     m_iPage = 3
251:     cmdNext.Caption = "Finish"
252:     If optExtent(0).value Then
253:       If txtMargin.Text = "" Then
254:         cmdNext.Enabled = False
255:       Else
256:         cmdNext.Enabled = True
257:       End If
258:     ElseIf optExtent(1).value Then
259:       If txtFixed.Text = "" Then
260:         cmdNext.Enabled = False
261:       Else
262:         cmdNext.Enabled = True
263:       End If
264:     Else
265:       cmdNext.Enabled = True
266:     End If
  Case 3  'Finish button selected
268:     CreateSeries
269:     Unload Me
270:   End Select
  
  Exit Sub
ErrHand:
274:   MsgBox "cmdNext_click - " & Err.Description
  Exit Sub
End Sub

Private Sub CreateSeries()
On Error GoTo ErrHandler:
  Dim pMapSeries As IDSMapSeries, pSpatialQuery As ISpatialFilter
  Dim pTmpPage As tmpPageClass, pTmpColl As Collection, pClone As IClone
  Dim pSeriesOpt As IDSMapSeriesOptions, pFeatLayerSel As IFeatureSelection
  Dim pSeriesProps As IDSMapSeriesProps, pMapPage As IDSMapPage
  Dim pDoc As IMxDocument, pMap As IMap, lCount As Long, lLoop As Long
  Dim pFeatLayer As IFeatureLayer, pQuery As IQueryFilter, pCursor As IFeatureCursor
  Dim pFeature As IFeature, lIndex As Long, sName As String, sFieldName As String
  Dim pNode As Node, pMapBook As IDSMapBook
  Dim pActiveView As IActiveView, lRotIndex As Long, lScaleIndex As Long
  'Added 6/18/03 to support cross hatch outside clip area
  Dim pSeriesOpt2 As IDSMapSeriesOptions2
  Dim pSeriesOpt3 As IDSMapSeriesOptions3    'Added 11/23/04 to support tile selection
  'Add 2/18/04 to support the storing of page numbers
  Dim lPageNumber As Long
  
295:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
298:   pMapBook.EnableBook = True
299:   Set pDoc = m_pApp.Document
  
301:   Set pMapSeries = New DSMapSeries
302:   Set pSeriesOpt = pMapSeries
303:   Set pSeriesOpt2 = pSeriesOpt  'Added 6/18/03 to support cross hatch outside clip area