frmseriesproperties.frm

一个不错的插件

139:     m_pSeriesOptions.MarginType = cmbMargin.ListIndex
140:   ElseIf optExtent(1).value Then    'Fixed
141:     m_pSeriesOptions.ExtentType = 1
142:     m_pSeriesOptions.FixedScale = txtFixed.Text
143:   Else                        'Data driven
144:     If m_pSeriesOptions.ExtentType <> 2 Or m_pSeriesOptions.RotationField <> cmbRotateField.Text Then
145:       UpdatePageValues "SCALE", cmbDataDriven.Text
146:     End If
147:     m_pSeriesOptions.ExtentType = 2
148:     m_pSeriesOptions.DataDrivenField = cmbDataDriven.Text
149:   End If
  
151:   Unload Me
  
  Exit Sub
  
ErrHand:
156:   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
165:   Set pDoc = m_pApp.Document
166:   Set pSeries = m_pSeriesOptions
167:   Set pSeriesProps = pSeries
168:   Set pMap = FindDataFrame(pDoc, pSeriesProps.DataFrameName)
  If pMap Is Nothing Then Exit Sub
  
171:   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
175:   Set pDataset = pIndexLayer.FeatureClass
176:   Set pWorkspace = pDataset.Workspace
177:   Set pQueryDef = pWorkspace.CreateQueryDef
178:   pQueryDef.Tables = pDataset.Name
179:   pQueryDef.SubFields = sFieldName & "," & pSeriesProps.IndexFieldName
180:   Set pCursor = pQueryDef.Evaluate
181:   Set pColl = New Collection
182:   Set pRow = pCursor.NextRow
183:   Do While Not pRow Is Nothing
184:     If Not IsNull(pRow.value(0)) And Not IsNull(pRow.value(1)) Then
185:       pColl.Add pRow.value(0), pRow.value(1)
186:     End If
187:     Set pRow = pCursor.NextRow
188:   Loop
  
  'Now loop through the pages and try to find the corresponding tile name in the collection
  On Error GoTo ErrNoKey:
192:   For lLoop = 0 To pSeries.PageCount - 1
193:     Set pPage = pSeries.Page(lLoop)
194:     If sProperty = "ROTATION" Then
195:       pPage.PageRotation = pColl.Item(pPage.PageName)
196:     Else
197:       pPage.PageScale = pColl.Item(pPage.PageName)
198:     End If
199:   Next lLoop

  Exit Sub

ErrNoKey:
204:   Resume Next
ErrHand:
206:   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
215:   Set pMapBook = GetMapBookExtension(m_pApp)
  If pMapBook Is Nothing Then Exit Sub
  
218:   Set pSeriesProps = pMapBook.ContentItem(0)
219:   Set m_pSeriesOptions = pSeriesProps
220:   Set m_pSeriesOptions2 = m_pSeriesOptions
221:   Set m_pSeriesOptions3 = m_pSeriesOptions
  
  'Index Settings Tab
224:   cmbDetailFrame.Clear
225:   cmbDetailFrame.AddItem pSeriesProps.DataFrameName
226:   cmbDetailFrame.Text = pSeriesProps.DataFrameName
227:   cmbIndexLayer.Clear
228:   cmbIndexLayer.AddItem pSeriesProps.IndexLayerName
229:   cmbIndexLayer.Text = pSeriesProps.IndexLayerName
230:   cmbIndexField.Clear
231:   cmbIndexField.AddItem pSeriesProps.IndexFieldName
232:   cmbIndexField.Text = pSeriesProps.IndexFieldName
  
  'Tile Settings Tab
235:   optTiles(pSeriesProps.TileSelectionMethod) = True
236:   lstSuppressTiles.Clear
237:   If pSeriesProps.SuppressLayers Then
238:     chkSuppress.value = 1
239:     For lLoop = 0 To pSeriesProps.SuppressLayerCount - 1
240:       lstSuppressTiles.AddItem pSeriesProps.SuppressLayer(lLoop)
241:       lstSuppressTiles.Selected(lLoop) = True
242:     Next lLoop
243:   Else
244:     chkSuppress.value = 0
245:   End If
246:   txtNumbering.Text = CStr(pSeriesProps.StartNumber)  'Added 2/18/2004
  
  'Options tab
249:   PopulateFieldCombos
250:   cmbMargin.Clear
251:   cmbMargin.AddItem "percent"
252:   cmbMargin.AddItem "mapunits"
253:   cmbMargin.Text = "percent"
254:   optExtent(m_pSeriesOptions.ExtentType).value = True
255:   cmdOK.Enabled = True
  Select Case m_pSeriesOptions.ExtentType
  Case 0
258:     txtMargin.Text = m_pSeriesOptions.Margin
259:     If m_pSeriesOptions.MarginType = 0 Then
260:       cmbMargin.Text = "percent"
261:     Else
262:       cmbMargin.Text = "mapunits"
263:     End If
  Case 1
265:     txtFixed.Text = m_pSeriesOptions.FixedScale
  Case 2
267:     cmbDataDriven.Text = m_pSeriesOptions.DataDrivenField
268:   End Select
269:   If m_pSeriesOptions.RotateFrame Then
270:     chkOptions(0).value = 1
271:     cmbRotateField.Text = m_pSeriesOptions.RotationField
272:   Else
273:     chkOptions(0).value = 0
274:   End If
  
  'Update 6/18/03 to support cross hatching of clip area
  Select Case m_pSeriesOptions2.ClipData
  Case 0   'No clipping
279:     chkOptions(1).value = 0
280:     chkOptions(3).value = 0
281:     chkOptions(3).Enabled = False
  Case 1   'Clip only
283:     chkOptions(1).value = 1
284:     chkOptions(3).value = 0
285:     chkOptions(3).Enabled = True
  Case 2   'Clip with cross hatch outside clip area
287:     chkOptions(1).value = 1
288:     chkOptions(3).value = 1
289:     chkOptions(3).Enabled = True
290:   End Select
'  If m_pSeriesOptions.ClipData Then
'    chkOptions(1).Value = 1
'  Else
'    chkOptions(1).Value = 0
'  End If

297:   If m_pSeriesOptions.LabelNeighbors Then
298:     chkOptions(2).value = 1
299:     cmdLabelProps.Enabled = True
300:   Else
301:     chkOptions(2).value = 0
302:     cmdLabelProps.Enabled = False
303:   End If
304:   Set m_pTextSym = m_pSeriesOptions.LabelSymbol
  
306:   If m_pSeriesOptions3.SelectTile Then  'Added 11/23/04
307:     chkOptions(4).value = 1
308:     m_bWasSelecting = True
309:   Else
310:     chkOptions(4).value = 0
311:     m_bWasSelecting = False
312:   End If
  
  'Make sure the wizard stays on top
315:   TopMost Me
  
  Exit Sub
ErrHand:
319:   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
  
327:   Set pDoc = m_pApp.Document
328:   Set pMap = FindDataFrame(pDoc, cmbDetailFrame.Text)
329:   If pMap Is Nothing Then
330:     MsgBox "Could not find detail frame!!!"
    Exit Sub
332:   End If
  
334:   Set pIndexLayer = FindLayer(cmbIndexLayer.Text, pMap)
335:   If pIndexLayer Is Nothing Then
336:     MsgBox "Could not find specified layer!!!"
    Exit Sub
338:   End If
  
  'Populate the index layer combos
341:   Set pFields = pIndexLayer.FeatureClass.Fields
342:   cmbDataDriven.Clear
343:   cmbRotateField.Clear
344:   For lLoop = 0 To pFields.FieldCount - 1
    Select Case pFields.Field(lLoop).Type
    Case esriFieldTypeDouble, esriFieldTypeSingle, esriFieldTypeInteger
347:       If UCase(pFields.Field(lLoop).Name) <> "SHAPE_LENGTH" And _
       UCase(pFields.Field(lLoop).Name) <> "SHAPE_AREA" Then
349:         cmbDataDriven.AddItem pFields.Field(lLoop).Name
350:         cmbRotateField.AddItem pFields.Field(lLoop).Name
351:       End If
352:     End Select
353:   Next lLoop
354:   If cmbDataDriven.ListCount > 0 Then
355:     cmbDataDriven.ListIndex = 0
356:     cmbRotateField.ListIndex = 0
357:     optExtent.Item(2).Enabled = True
358:     chkOptions(0).Enabled = True
359:   Else
360:     optExtent.Item(2).Enabled = False
361:     chkOptions(0).Enabled = False
362:   End If
  
  Exit Sub
  
ErrHand:
367:   MsgBox "PopulateFieldCombos - " & Err.Description
End Sub

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

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

Private Sub optExtent_Click(Index As Integer)
On Error GoTo ErrHand:
  Select Case Index
  Case 0  'Variable
382:     txtMargin.Enabled = True
383:     cmbMargin.Enabled = True
384:     txtFixed.Enabled = False
385:     cmbDataDriven.Enabled = False
386:     If txtMargin.Text = "" Then
387:       cmdOK.Enabled = False
388:     Else
389:       cmdOK.Enabled = True
390:     End If
  Case 1  'Fixed
392:     txtMargin.Enabled = False
393:     cmbMargin.Enabled = False
394:     txtFixed.Enabled = True
395:     cmbDataDriven.Enabled = False
396:     If txtFixed.Text = "" Then
397:       cmdOK.Enabled = False
398:     Else
399:       cmdOK.Enabled = True
400:     End If
  Case 2  'Data driven
402:     txtMargin.Enabled = False
403:     cmbMargin.Enabled = False
404:     txtFixed.Enabled = False
405:     cmbDataDriven.Enabled = True
406:     cmdOK.Enabled = True
407:   End Select

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

Private Sub txtFixed_KeyUp(KeyCode As Integer, Shift As Integer)
415:   If Not IsNumeric(txtFixed.Text) Then
416:     txtFixed.Text = ""
417:   End If
418:   If txtFixed.Text <> "" Then
419:     cmdOK.Enabled = True
420:   End If
End Sub

Private Sub txtMargin_KeyUp(KeyCode As Integer, Shift As Integer)
424:   If Not IsNumeric(txtMargin.Text) Then
425:     txtMargin.Text = ""
426:   End If
427:   If txtMargin.Text <> "" Then
428:     cmdOK.Enabled = True
429:   End If
End Sub