frmmapserieswiz.frm

使用VB和ArcObject结合的程序

         Index           =   3
         Left            =   90
         TabIndex        =   44
         Top             =   2610
         Width           =   2295
      End
      Begin VB.Label Label1 
         Caption         =   $"frmMapSeriesWiz.frx":00E0
         Height          =   615
         Index           =   1
         Left            =   30
         TabIndex        =   15
         Top             =   60
         Width           =   6705
      End
   End
   Begin VB.CommandButton cmdBack 
      Caption         =   "< Back"
      Height          =   345
      Left            =   3330
      TabIndex        =   2
      Top             =   3780
      Width           =   1125
   End
   Begin VB.CommandButton cmdNext 
      Caption         =   "Next >"
      Height          =   345
      Left            =   4470
      TabIndex        =   1
      Top             =   3780
      Width           =   1125
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   345
      Left            =   5760
      TabIndex        =   0
      Top             =   3780
      Width           =   1125
   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 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

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:

14:   If Not m_pCurrentFrame Is Nothing Then m_pCurrentFrame.Visible = False
15:   pFrame.Visible = True
16:   pFrame.Height = 3495
17:   pFrame.Width = 6825
18:   pFrame.Left = 30
19:   pFrame.Top = 30
20:   Set m_pCurrentFrame = pFrame
21:   pFrame.Visible = True
     
  Exit Sub
ErrHand:
25:   MsgBox "PositionFrame - " & Err.Description
  Exit Sub
End Sub

Private Sub chkOptions_Click(Index As Integer)
  Select Case Index
  Case 0  'Rotate
32:     If chkOptions(0).Value = 0 Then
33:       cmbRotateField.Enabled = False
34:     Else
35:       cmbRotateField.Enabled = True
36:     End If
  Case 1  'Clip to outline
38:     If chkOptions(1).Value = 0 Then
39:       chkOptions(3).Enabled = False
40:       chkOptions(3).Value = 0
41:     Else
42:       chkOptions(3).Enabled = True
43:     End If
  Case 2  'Label neighboring tiles
45:     If chkOptions(2).Value = 0 Then
46:       cmdLabelProps.Enabled = False
47:     Else
48:       cmdLabelProps.Enabled = True
49:     End If
50:   End Select
End Sub

Private Sub chkSuppress_Click()
54:   If chkSuppress.Value = 0 Then
55:     lstSuppressTiles.Enabled = False
56:   Else
57:     lstSuppressTiles.Enabled = True
58:   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
67:   cmdNext.Enabled = False
  
  'Find the selected map
70:   cmbIndexLayer.Clear
71:   If cmbDetailFrame.Text = "" Then
72:     MsgBox "No detail frame selected!!!"
    Exit Sub
74:   End If
  
76:   Set pDoc = m_pApp.Document
77:   Set m_pMap = FindDataFrame(pDoc, cmbDetailFrame.Text)
78:   If m_pMap Is Nothing Then
79:     MsgBox "Could not find detail frame!!!"
    Exit Sub
81:   End If
  
  'Populate the index layer combo
84:   lstSuppressTiles.Clear
85:   cmbIndexLayer.Clear
86:   For lLoop = 0 To m_pMap.LayerCount - 1
87:     If TypeOf m_pMap.Layer(lLoop) Is ICompositeLayer Then
88:       CompositeLayer m_pMap.Layer(lLoop)
89:     Else
90:       LayerCheck m_pMap.Layer(lLoop)
91:     End If
92:   Next lLoop
93:   If cmbIndexLayer.ListCount = 0 Then
94:     MsgBox "You need at least one polygon layer in the detail frame to serve as the index layer!!!"
95:   Else
96:     cmbIndexLayer.ListIndex = 0
97:   End If
  
  Exit Sub
ErrHand:
101:   MsgBox "cmbDetailFrame_Click - " & Err.Description
End Sub

Private Sub CompositeLayer(pCompLayer As ICompositeLayer)
On Error GoTo ErrHand:
  Dim lLoop As Long
107:   For lLoop = 0 To pCompLayer.count - 1
108:     If TypeOf pCompLayer.Layer(lLoop) Is ICompositeLayer Then
109:       CompositeLayer pCompLayer.Layer(lLoop)
110:     Else
111:       LayerCheck pCompLayer.Layer(lLoop)
112:     End If
113:   Next lLoop

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

Private Sub LayerCheck(pLayer As ILayer)
On Error GoTo ErrHand:
  Dim pFeatLayer As IFeatureLayer
  
124:   If TypeOf pLayer Is IFeatureLayer Then
125:     Set pFeatLayer = pLayer
126:     If pFeatLayer.FeatureClass.ShapeType = esriGeometryPolygon Then
127:       cmbIndexLayer.AddItem pFeatLayer.Name
128:     End If
129:     lstSuppressTiles.AddItem pFeatLayer.Name
130:   End If

  Exit Sub
ErrHand:
134:   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
142:   cmdNext.Enabled = False
  
  'Find the selected layer
145:   cmbIndexField.Clear
146:   If cmbIndexLayer.Text = "" Then
147:     MsgBox "No index layer selected!!!"
    Exit Sub
149:   End If
  
151:   Set m_pIndexLayer = FindLayer(cmbIndexLayer.Text, m_pMap)
152:   If m_pIndexLayer Is Nothing Then
153:     MsgBox "Could not find specified layer!!!"
    Exit Sub
155:   End If
  
  'Populate the index layer combos
158:   Set pFields = m_pIndexLayer.FeatureClass.Fields
159:   cmbDataDriven.Clear
160:   cmbRotateField.Clear
161:   For lLoop = 0 To pFields.FieldCount - 1
    Select Case pFields.Field(lLoop).Type
    Case esriFieldTypeString
164:       cmbIndexField.AddItem pFields.Field(lLoop).Name
    Case esriFieldTypeDouble, esriFieldTypeSingle, esriFieldTypeInteger
166:       If UCase(pFields.Field(lLoop).Name) <> "SHAPE_LENGTH" And _
       UCase(pFields.Field(lLoop).Name) <> "SHAPE_AREA" Then
168:         cmbDataDriven.AddItem pFields.Field(lLoop).Name
169:         cmbRotateField.AddItem pFields.Field(lLoop).Name
170:       End If
171:     End Select
172:   Next lLoop
173:   If cmbIndexField.ListCount = 0 Then
'    MsgBox "You need at least one string field in the layer for labeling the pages!!!"
175:   Else
176:     cmbIndexField.ListIndex = 0
177:     cmdNext.Enabled = True
178:   End If
179:   If cmbDataDriven.ListCount > 0 Then
180:     cmbDataDriven.ListIndex = 0
181:     cmbRotateField.ListIndex = 0
182:     optExtent.Item(2).Enabled = True
183:     chkOptions(0).Enabled = True
184:   Else
185:     optExtent.Item(2).Enabled = False
186:     chkOptions(0).Enabled = False
187:   End If

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

Private Sub cmdBack_Click()
195:   m_pCurrentFrame.Visible = False
  Select Case m_iPage
  Case 2
198:     PositionFrame fraPage1
199:     m_iPage = 1
  Case 3
201:     cmdNext.Caption = "Next >"
202:     PositionFrame fraPage2
203:     m_iPage = 2
204:   End Select
205:   cmdNext.Enabled = True
End Sub

Private Sub cmdCancel_Click()
209:   Unload Me
End Sub

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

Private Sub cmdNext_Click()
On Error GoTo ErrHand:
  Dim pMapSeries As IDSMapSeries
227:   m_pCurrentFrame.Visible = False
228:   cmdBack.Enabled = True
  Select Case m_iPage
  Case 1  'Done with date frame and index layer
231:     CheckForSelected    'Check index layer to see if there are selected features
232:     PositionFrame fraPage2
233:     m_iPage = 2
  Case 2  'Done with tile specification
235:     PositionFrame fraPage3
236:     m_iPage = 3
237:     cmdNext.Caption = "Finish"
238:     If optExtent(0).Value Then
239:       If txtMargin.Text = "" Then
240:         cmdNext.Enabled = False
241:       Else
242:         cmdNext.Enabled = True
243:       End If
244:     ElseIf optExtent(1).Value Then
245:       If txtFixed.Text = "" Then
246:         cmdNext.Enabled = False
247:       Else
248:         cmdNext.Enabled = True
249:       End If
250:     Else
251:       cmdNext.Enabled = True
252:     End If
  Case 3  'Finish button selected
254:     CreateSeries
255:     Unload Me
256:   End Select
  
  Exit Sub
ErrHand:
260:   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
  'Add 2/18/04 to support the storing of page numbers
  Dim lPageNumber As Long
  
280:   Set pMapBook = GetMapBookExtension(m_pApp)