frmsmapsettings.frm
来自「一个不错的插件」· FRM 代码 · 共 1,599 行 · 第 1/4 页
FRM
1,599 行
Begin VB.Label Label13
Caption = "Assign roles to field names."
Height = 255
Left = 120
TabIndex = 7
Top = 240
Width = 4575
End
End
Begin VB.Frame fraDestinationFeatureClass
Height = 4695
Left = 0
TabIndex = 1
Top = 0
Width = 4815
Begin VB.TextBox txtStripMapSeriesName
Height = 315
Left = 2040
TabIndex = 53
Text = "Strip Map Name"
Top = 720
Width = 2295
End
Begin VB.CommandButton cmdSetNewGridLayer
Height = 315
Left = 4320
Picture = "frmSMapSettings.frx":0449
Style = 1 'Graphical
TabIndex = 19
ToolTipText = "Set new Grid Layer"
Top = 2400
Width = 315
End
Begin VB.TextBox txtNewGridLayer
Height = 315
Left = 2040
TabIndex = 18
Top = 2400
Width = 2295
End
Begin VB.OptionButton optLayerSource
Caption = "Create a new Layer:"
Height = 255
Index = 1
Left = 240
TabIndex = 17
Top = 2400
Width = 1815
End
Begin VB.OptionButton optLayerSource
Caption = "Use existing Layer:"
Height = 255
Index = 0
Left = 240
TabIndex = 16
Top = 2040
Value = -1 'True
Width = 1695
End
Begin VB.ComboBox cmbPolygonLayers
Height = 315
Left = 2040
Sorted = -1 'True
TabIndex = 3
Top = 1995
Width = 2535
End
Begin VB.CheckBox chkRemovePreviousGrids
Caption = "Clear existing grids. This will delete all the current"
Height = 255
Left = 240
TabIndex = 2
Top = 3000
Width = 4335
End
Begin VB.CheckBox chkFlipLine
Caption = "Flip the line. This will reverse the orientation of the"
Height = 255
Left = 240
TabIndex = 20
Top = 3720
Width = 3975
End
Begin VB.Label Label11
Alignment = 1 'Right Justify
Caption = "Name:"
Height = 255
Left = 960
TabIndex = 55
Top = 720
Width = 975
End
Begin VB.Label Label3
Caption = $"frmSMapSettings.frx":08C3
Height = 400
Left = 120
TabIndex = 54
Top = 240
Width = 4575
End
Begin VB.Label Label6
Caption = $"frmSMapSettings.frx":094A
Height = 615
Left = 600
TabIndex = 21
Top = 3945
Width = 4095
End
Begin VB.Label lblClearExistingGridsPart2
Caption = "features in the feature class."
Height = 255
Left = 600
TabIndex = 6
Top = 3225
Width = 3855
End
Begin VB.Label Label5
Caption = $"frmSMapSettings.frx":09E3
Height = 615
Left = 120
TabIndex = 5
Top = 1320
Width = 4575
End
End
Begin VB.CommandButton cmdBack
Caption = "< Back"
Height = 375
Left = 1440
TabIndex = 15
Top = 4800
Width = 1095
End
Begin VB.CommandButton cmdNext
Caption = "Next >"
Height = 375
Left = 2540
TabIndex = 14
Top = 4800
Width = 1095
End
Begin VB.CommandButton cmdClose
Caption = "Cancel"
Height = 375
Left = 3720
TabIndex = 0
Top = 4800
Width = 1095
End
End
Attribute VB_Name = "frmSMapSettings"
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_Application As IApplication
Public StripMapSettings As clsCreateStripMap
Private m_Polyline As IPolyline
Private m_bIsGeoDatabase As Boolean
Private m_FileType As intersectFileType
Private m_OutputLayer As String
Private m_OutputDataset As String
Private m_OutputFClass As String
Private m_Step As Integer
Private Const c_DefaultFld_StripMapName = "SMAP_NAME"
Private Const c_DefaultFld_SeriesNum = "SMAP_NUM"
Private Const c_DefaultFld_MapAngle = "SMAP_ANGLE"
Private Const c_DefaultFld_MapScale = "SMAP_SCALE"
Private Sub SetControlsState()
Dim dScale As Double
Dim dGHeight As Double
Dim dGWidth As Double
Dim dStartX As Double
Dim dStartY As Double
Dim dEndX As Double
Dim dEndY As Double
Dim bValidName As Boolean
Dim bValidScale As Boolean
Dim bValidSize As Boolean
Dim bValidTarget As Boolean
Dim bValidRequiredFields As Boolean
Dim bPolylineWithinDataset As Boolean
Dim bNewFClassSet As Boolean
Dim bCreatingNewFClass As Boolean
Dim bDuplicateFieldsSelected As Boolean
Dim pFL As IFeatureLayer
Dim pDatasetExtent As IEnvelope
Dim dAWidth As Double
Dim dAHeight As Double
Dim i As Integer
On Error GoTo eh
' Protect against zero length string_to_double conversions
57: If Len(lblCurrentMapScale.Caption) = 0 Then lblCurrentMapScale.Caption = "0"
58: If Len(txtManualMapScale.Text) = 0 Then
59: dScale = 0
60: Else
61: dScale = CDbl(txtManualMapScale.Text)
62: End If
63: If Len(txtManualGridHeight.Text) = 0 Then
64: dGHeight = 0
65: Else
66: dGHeight = CDbl(txtManualGridHeight.Text)
67: End If
68: If Len(txtManualGridWidth.Text) = 0 Then
69: dGWidth = 0
70: Else
71: dGWidth = CDbl(txtManualGridWidth.Text)
72: End If
73: If Len(txtAbsoluteGridHeight.Text) = 0 Then
74: dAHeight = 0
75: Else
76: dAHeight = CDbl(txtAbsoluteGridHeight.Text)
77: End If
78: If Len(txtAbsoluteGridWidth.Text) = 0 Then
79: dAWidth = 0
80: Else
81: dAWidth = CDbl(txtAbsoluteGridWidth.Text)
82: End If
83: i = 1
' Calc values
86: bValidName = Len(txtStripMapSeriesName.Text) > 0
87: bValidScale = (optScaleSource(0).value And CDbl(lblCurrentMapScale.Caption) > 0) Or _
(optScaleSource(1).value And dScale > 0) Or _
(optScaleSource(2).value And dAHeight > 0 And dAWidth > 0)
90: bValidSize = (optGridSize(0).value) Or _
(optGridSize(1).value And dGHeight > 0 And dGWidth > 0) Or _
(optScaleSource(2).value And CDbl(txtManualGridWidth.Text) > 0)
93: bCreatingNewFClass = optLayerSource(1).value
94: bNewFClassSet = (Len(txtNewGridLayer.Text) > 0)
95: bValidTarget = (cmbPolygonLayers.ListIndex > 0) Or (bCreatingNewFClass And bNewFClassSet)
96: bValidRequiredFields = (cmbFieldStripMapName.ListIndex > 0) And _
(cmbFieldGridAngle.ListIndex > 0) And _
(cmbFieldSeriesNumber.ListIndex > 0)
99: i = 2
100: If bValidTarget And (Not bCreatingNewFClass) Then
101: Set pFL = FindFeatureLayerByName(cmbPolygonLayers.List(cmbPolygonLayers.ListIndex), m_Application)
102: If pFL.FeatureClass.FeatureDataset Is Nothing Then
103: bPolylineWithinDataset = True
104: Else
105: Set pDatasetExtent = GetValidExtentForLayer(pFL)
106: bPolylineWithinDataset = (m_Polyline.Envelope.XMin >= pDatasetExtent.XMin And m_Polyline.Envelope.XMax <= pDatasetExtent.XMax) _
And (m_Polyline.Envelope.YMin >= pDatasetExtent.YMin And m_Polyline.Envelope.YMax <= pDatasetExtent.YMax)
108: End If
109: ElseIf bValidTarget And bCreatingNewFClass Then
110: bPolylineWithinDataset = True
111: End If
Dim a As Long, b As Long, c As Long
113: a = cmbFieldGridAngle.ListIndex
114: b = cmbFieldMapScale.ListIndex
115: c = cmbFieldSeriesNumber.ListIndex
116: bDuplicateFieldsSelected = (a > 0 And (a = b Or a = c)) _
Or (b > 0 And (b = c))
118: i = 3
' Set states
Select Case m_Step
Case 0: ' Set the target feature layer
123: cmdBack.Enabled = False
124: cmdNext.Enabled = bValidTarget And bValidName
125: cmdNext.Caption = "Next >"
126: cmbPolygonLayers.Enabled = Not bCreatingNewFClass
127: chkRemovePreviousGrids.Enabled = Not bCreatingNewFClass
128: lblClearExistingGridsPart2.Enabled = Not bCreatingNewFClass
129: cmdSetNewGridLayer.Enabled = bCreatingNewFClass
Case 1: ' Set the fields to populate
131: cmdBack.Enabled = True
132: cmdNext.Enabled = (bValidRequiredFields And Not bDuplicateFieldsSelected)
133: cmbFieldStripMapName.Enabled = Not bCreatingNewFClass
134: cmbFieldGridAngle.Enabled = Not bCreatingNewFClass
135: cmbFieldMapScale.Enabled = Not bCreatingNewFClass
136: cmbFieldSeriesNumber.Enabled = Not bCreatingNewFClass
Case 2: ' Set the scale / starting_coords
138: cmdBack.Enabled = True
139: cmdNext.Enabled = bValidScale And bPolylineWithinDataset
140: cmdNext.Caption = "Next >"
Case 3: ' Set the dataframe properties
142: cmdBack.Enabled = True
143: cmdNext.Enabled = bValidSize
144: cmdNext.Caption = "Finish"
145: txtManualGridHeight.Enabled = Not (optScaleSource(2).value)
146: txtManualGridHeight.Locked = (optScaleSource(2).value)
147: lblFrameHeight.Enabled = Not (optScaleSource(2).value)
148: optGridSize(0).Enabled = Not (optScaleSource(2).value)
Case Else:
150: cmdBack.Enabled = False
151: cmdNext.Enabled = False
152: End Select
153: i = 4
155: txtManualMapScale.Enabled = optScaleSource(1).value
156: txtManualGridWidth.Enabled = optGridSize(1).value
157: txtManualGridHeight.Enabled = optGridSize(1).value
158: cmbGridSizeUnits.Enabled = optGridSize(1).value
159: If optScaleSource(1).value Then
160: If bValidScale Then
161: txtManualMapScale.ForeColor = (&H0) ' Black
162: Else
163: txtManualMapScale.ForeColor = (&HFF) ' Red
164: End If
165: End If
166: If optGridSize(1).value Then
167: If bValidSize Then
168: txtManualGridWidth.ForeColor = (&H0) ' Black
169: txtManualGridHeight.ForeColor = (&H0)
170: Else
171: txtManualGridWidth.ForeColor = (&HFF) ' Red
172: txtManualGridHeight.ForeColor = (&HFF)
173: End If
174: End If
Exit Sub
177: Resume
eh:
179: MsgBox Err.Description, vbExclamation, "SetControlsState " & i
End Sub
Private Sub cmbFieldStripMapName_Click()
183: SetControlsState
End Sub
Private Sub cmbFieldMapScale_Click()
187: SetControlsState
End Sub
Private Sub cmbFieldSeriesNumber_Click()
191: SetControlsState
End Sub
Private Sub cmbFieldGridAngle_Click()
195: SetControlsState
End Sub
Private Sub cmbPolygonLayers_Click()
Dim pFL As IFeatureLayer
Dim pFields As IFields
Dim lLoop As Long
' Populate the fields combo boxes
203: If cmbPolygonLayers.ListIndex > 0 Then
204: Set pFL = FindFeatureLayerByName(cmbPolygonLayers.List(cmbPolygonLayers.ListIndex), m_Application)
205: Set pFields = pFL.FeatureClass.Fields
206: cmbFieldMapScale.Clear
207: cmbFieldStripMapName.Clear
208: cmbFieldSeriesNumber.Clear
209: cmbFieldGridAngle.Clear
210: cmbFieldStripMapName.AddItem "<None>"
211: cmbFieldGridAngle.AddItem "<None>"
212: cmbFieldMapScale.AddItem "<None>"
213: cmbFieldSeriesNumber.AddItem "<None>"
214: For lLoop = 0 To pFields.FieldCount - 1
215: If pFields.Field(lLoop).Type = esriFieldTypeString Then
216: cmbFieldStripMapName.AddItem pFields.Field(lLoop).Name
217: ElseIf pFields.Field(lLoop).Type = esriFieldTypeDouble Or _
pFields.Field(lLoop).Type = esriFieldTypeInteger Or _
pFields.Field(lLoop).Type = esriFieldTypeSmallInteger Or _
pFields.Field(lLoop).Type = esriFieldTypeSingle Then
221: cmbFieldMapScale.AddItem pFields.Field(lLoop).Name
222: cmbFieldGridAngle.AddItem pFields.Field(lLoop).Name
223: cmbFieldSeriesNumber.AddItem pFields.Field(lLoop).Name
224: End If
225: Next
226: cmbFieldStripMapName.ListIndex = 0
227: cmbFieldGridAngle.ListIndex = 0
228: cmbFieldMapScale.ListIndex = 0
229: cmbFieldSeriesNumber.ListIndex = 0
230: End If
231: SetControlsState
End Sub
Private Sub cmdBack_Click()
235: m_Step = m_Step - 1
236: If m_Step < 0 Then
237: m_Step = 0
238: End If
239: SetVisibleControls m_Step
240: SetControlsState
End Sub
Private Sub cmdClose_Click()
244: Set m_Application = Nothing
245: Set Me.StripMapSettings = Nothing
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?