frmseriesproperties.frm

使用VB和ArcObject结合的程序

106:     Else
107:       m_pSeriesOptions.Margin = CDbl(txtMargin.Text)
108:     End If
109:     m_pSeriesOptions.MarginType = cmbMargin.ListIndex
110:   ElseIf optExtent(1).Value Then    'Fixed
111:     m_pSeriesOptions.ExtentType = 1
112:     m_pSeriesOptions.FixedScale = txtFixed.Text
113:   Else                        'Data driven
114:     If m_pSeriesOptions.ExtentType <> 2 Or m_pSeriesOptions.RotationField <> cmbRotateField.Text Then
115:       UpdatePageValues "SCALE", cmbDataDriven.Text
116:     End If
117:     m_pSeriesOptions.ExtentType = 2
118:     m_pSeriesOptions.DataDrivenField = cmbDataDriven.Text
119:   End If
  
121:   Unload Me
  
  Exit Sub
  
ErrHand:
126:   MsgBox "cmdOK_Click - " & Err.Description
End Sub

Private Sub UpdatePageValues(sProperty As String, sFieldName As String)
On Error GoTo ErrHand:
  Dim lLoop As Long, pSeries As IDSMapSeries, pPage As IDSMapPage
  Dim pDoc As IMxDocument, pMap As IMap, pSeriesProps As IDSMapSeriesProps
  Dim pIndexLayer As IFeatureLayer, pDataset As IDataset, pWorkspace As IFeatureWorkspace
  Dim pQueryDef As IQueryDef, pCursor As ICursor, pRow As IRow, pColl As Collection
135:   Set pDoc = m_pApp.Document
136:   Set pSeries = m_pSeriesOptions
137:   Set pSeriesProps = pSeries
138:   Set pMap = FindDataFrame(pDoc, pSeriesProps.DataFrameName)
  If pMap Is Nothing Then Exit Sub
  
141:   Set pIndexLayer = FindLayer(pSeriesProps.IndexLayerName, pMap)
  If pIndexLayer Is Nothing Then Exit Sub
  
  'Loop through the features in the index layer creating a collection of the scales and tile names
145:   Set pDataset = pIndexLayer.FeatureClass
146:   Set pWorkspace = pDataset.Workspace
147:   Set pQueryDef = pWorkspace.CreateQueryDef
148:   pQueryDef.Tables = pDataset.Name
149:   pQueryDef.SubFields = sFieldName & "," & pSeriesProps.IndexFieldName
150:   Set pCursor = pQueryDef.Evaluate
151:   Set pColl = New Collection
152:   Set pRow = pCursor.NextRow
153:   Do While Not pRow Is Nothing
154:     If Not IsNull(pRow.Value(0)) And Not IsNull(pRow.Value(1)) Then
155:       pColl.Add pRow.Value(0), pRow.Value(1)
156:     End If
157:     Set pRow = pCursor.NextRow
158:   Loop
  
  'Now loop through the pages and try to find the corresponding tile name in the collection
  On Error GoTo ErrNoKey:
162:   For lLoop = 0 To pSeries.PageCount - 1
163:     Set pPage = pSeries.Page(lLoop)
164:     If sProperty = "ROTATION" Then
165:       pPage.PageRotation = pColl.Item(pPage.PageName)
166:     Else
167:       pPage.PageScale = pColl.Item(pPage.PageName)
168:     End If
169:   Next lLoop

  Exit Sub

ErrNoKey:
174:   Resume Next
ErrHand:
176:   MsgBox "UpdatePageValues - " & Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo ErrHand:
  Dim pMapBook As IDSMapBook
  Dim pSeriesProps As IDSMapSeriesProps
  Dim lLoop As Long
  'Check to see if a MapSeries already exists
185:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
188:   Set pSeriesProps = pMapBook.ContentItem(0)
189:   Set m_pSeriesOptions = pSeriesProps
190:   Set m_pSeriesOptions2 = m_pSeriesOptions
  
  'Index Settings Tab
193:   cmbDetailFrame.Clear
194:   cmbDetailFrame.AddItem pSeriesProps.DataFrameName
195:   cmbDetailFrame.Text = pSeriesProps.DataFrameName
196:   cmbIndexLayer.Clear
197:   cmbIndexLayer.AddItem pSeriesProps.IndexLayerName
198:   cmbIndexLayer.Text = pSeriesProps.IndexLayerName
199:   cmbIndexField.Clear
200:   cmbIndexField.AddItem pSeriesProps.IndexFieldName
201:   cmbIndexField.Text = pSeriesProps.IndexFieldName
  
  'Tile Settings Tab
204:   optTiles(pSeriesProps.TileSelectionMethod) = True
205:   lstSuppressTiles.Clear
206:   If pSeriesProps.SuppressLayers Then
207:     chkSuppress.Value = 1
208:     For lLoop = 0 To pSeriesProps.SuppressLayerCount - 1
209:       lstSuppressTiles.AddItem pSeriesProps.SuppressLayer(lLoop)
210:       lstSuppressTiles.Selected(lLoop) = True
211:     Next lLoop
212:   Else
213:     chkSuppress.Value = 0
214:   End If
215:   txtNumbering.Text = CStr(pSeriesProps.StartNumber)  'Added 2/18/2004
  
  'Options tab
218:   PopulateFieldCombos
219:   cmbMargin.Clear
220:   cmbMargin.AddItem "percent"
221:   cmbMargin.AddItem "mapunits"
222:   cmbMargin.Text = "percent"
223:   optExtent(m_pSeriesOptions.ExtentType).Value = True
224:   cmdOK.Enabled = True
  Select Case m_pSeriesOptions.ExtentType
  Case 0
227:     txtMargin.Text = m_pSeriesOptions.Margin
228:     If m_pSeriesOptions.MarginType = 0 Then
229:       cmbMargin.Text = "percent"
230:     Else
231:       cmbMargin.Text = "mapunits"
232:     End If
  Case 1
234:     txtFixed.Text = m_pSeriesOptions.FixedScale
  Case 2
236:     cmbDataDriven.Text = m_pSeriesOptions.DataDrivenField
237:   End Select
238:   If m_pSeriesOptions.RotateFrame Then
239:     chkOptions(0).Value = 1
240:     cmbRotateField.Text = m_pSeriesOptions.RotationField
241:   Else
242:     chkOptions(0).Value = 0
243:   End If
  
  'Update 6/18/03 to support cross hatching of clip area
  Select Case m_pSeriesOptions2.ClipData
  Case 0   'No clipping
248:     chkOptions(1).Value = 0
249:     chkOptions(3).Value = 0
250:     chkOptions(3).Enabled = False
  Case 1   'Clip only
252:     chkOptions(1).Value = 1
253:     chkOptions(3).Value = 0
254:     chkOptions(3).Enabled = True
  Case 2   'Clip with cross hatch outside clip area
256:     chkOptions(1).Value = 1
257:     chkOptions(3).Value = 1
258:     chkOptions(3).Enabled = True
259:   End Select
'  If m_pSeriesOptions.ClipData Then
'    chkOptions(1).Value = 1
'  Else
'    chkOptions(1).Value = 0
'  End If

266:   If m_pSeriesOptions.LabelNeighbors Then
267:     chkOptions(2).Value = 1
268:     cmdLabelProps.Enabled = True
269:   Else
270:     chkOptions(2).Value = 0
271:     cmdLabelProps.Enabled = False
272:   End If
273:   Set m_pTextSym = m_pSeriesOptions.LabelSymbol
  
  'Make sure the wizard stays on top
276:   TopMost Me
  
  Exit Sub
ErrHand:
280:   MsgBox "frmSeriesProperties_Load - " & Err.Description
End Sub

Private Sub PopulateFieldCombos()
On Error GoTo ErrHand:
  Dim pIndexLayer As IFeatureLayer, pMap As IMap, lLoop As Long
  Dim pFields As IFields, pDoc As IMxDocument
  
288:   Set pDoc = m_pApp.Document
289:   Set pMap = FindDataFrame(pDoc, cmbDetailFrame.Text)
290:   If pMap Is Nothing Then
291:     MsgBox "Could not find detail frame!!!"
    Exit Sub
293:   End If
  
295:   Set pIndexLayer = FindLayer(cmbIndexLayer.Text, pMap)
296:   If pIndexLayer Is Nothing Then
297:     MsgBox "Could not find specified layer!!!"
    Exit Sub
299:   End If
  
  'Populate the index layer combos
302:   Set pFields = pIndexLayer.FeatureClass.Fields
303:   cmbDataDriven.Clear
304:   cmbRotateField.Clear
305:   For lLoop = 0 To pFields.FieldCount - 1
    Select Case pFields.Field(lLoop).Type
    Case esriFieldTypeDouble, esriFieldTypeSingle, esriFieldTypeInteger
308:       If UCase(pFields.Field(lLoop).Name) <> "SHAPE_LENGTH" And _
       UCase(pFields.Field(lLoop).Name) <> "SHAPE_AREA" Then
310:         cmbDataDriven.AddItem pFields.Field(lLoop).Name
311:         cmbRotateField.AddItem pFields.Field(lLoop).Name
312:       End If
313:     End Select
314:   Next lLoop
315:   If cmbDataDriven.ListCount > 0 Then
316:     cmbDataDriven.ListIndex = 0
317:     cmbRotateField.ListIndex = 0
318:     optExtent.Item(2).Enabled = True
319:     chkOptions(0).Enabled = True
320:   Else
321:     optExtent.Item(2).Enabled = False
322:     chkOptions(0).Enabled = False
323:   End If
  
  Exit Sub
  
ErrHand:
328:   MsgBox "PopulateFieldCombos - " & Err.Description
End Sub

Private Sub Form_Terminate()
332:   Set m_pApp = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
336:   Set m_pApp = Nothing
End Sub

Private Sub optExtent_Click(Index As Integer)
On Error GoTo ErrHand:
  Select Case Index
  Case 0  'Variable
343:     txtMargin.Enabled = True
344:     cmbMargin.Enabled = True
345:     txtFixed.Enabled = False
346:     cmbDataDriven.Enabled = False
347:     If txtMargin.Text = "" Then
348:       cmdOK.Enabled = False
349:     Else
350:       cmdOK.Enabled = True
351:     End If
  Case 1  'Fixed
353:     txtMargin.Enabled = False
354:     cmbMargin.Enabled = False
355:     txtFixed.Enabled = True
356:     cmbDataDriven.Enabled = False
357:     If txtFixed.Text = "" Then
358:       cmdOK.Enabled = False
359:     Else
360:       cmdOK.Enabled = True
361:     End If
  Case 2  'Data driven
363:     txtMargin.Enabled = False
364:     cmbMargin.Enabled = False
365:     txtFixed.Enabled = False
366:     cmbDataDriven.Enabled = True
367:     cmdOK.Enabled = True
368:   End Select

  Exit Sub
ErrHand:
372:   MsgBox "optExtent_Click - " & Err.Description
End Sub

Private Sub txtFixed_KeyUp(KeyCode As Integer, Shift As Integer)
376:   If Not IsNumeric(txtFixed.Text) Then
377:     txtFixed.Text = ""
378:   End If
379:   If txtFixed.Text <> "" Then
380:     cmdOK.Enabled = True
381:   End If
End Sub

Private Sub txtMargin_KeyUp(KeyCode As Integer, Shift As Integer)
385:   If Not IsNumeric(txtMargin.Text) Then
386:     txtMargin.Text = ""
387:   End If
388:   If txtMargin.Text <> "" Then
389:     cmdOK.Enabled = True
390:   End If
End Sub