frmsmapsettings.frm

使用VB和ArcObject结合的程序

         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 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

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
45:     If Len(lblCurrentMapScale.Caption) = 0 Then lblCurrentMapScale.Caption = "0"
46:     If Len(txtManualMapScale.Text) = 0 Then
47:         dScale = 0
48:     Else
49:         dScale = CDbl(txtManualMapScale.Text)
50:     End If
51:     If Len(txtManualGridHeight.Text) = 0 Then
52:         dGHeight = 0
53:     Else
54:         dGHeight = CDbl(txtManualGridHeight.Text)
55:     End If
56:     If Len(txtManualGridWidth.Text) = 0 Then
57:         dGWidth = 0
58:     Else
59:         dGWidth = CDbl(txtManualGridWidth.Text)
60:     End If
61:     If Len(txtAbsoluteGridHeight.Text) = 0 Then
62:         dAHeight = 0
63:     Else
64:         dAHeight = CDbl(txtAbsoluteGridHeight.Text)
65:     End If
66:     If Len(txtAbsoluteGridWidth.Text) = 0 Then
67:         dAWidth = 0
68:     Else
69:         dAWidth = CDbl(txtAbsoluteGridWidth.Text)
70:     End If
71: i = 1

    ' Calc values
74:     bValidName = Len(txtStripMapSeriesName.Text) > 0
75:     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)
78:     bValidSize = (optGridSize(0).Value) Or _
                 (optGridSize(1).Value And dGHeight > 0 And dGWidth > 0) Or _
                 (optScaleSource(2).Value And CDbl(txtManualGridWidth.Text) > 0)
81:     bCreatingNewFClass = optLayerSource(1).Value
82:     bNewFClassSet = (Len(txtNewGridLayer.Text) > 0)
83:     bValidTarget = (cmbPolygonLayers.ListIndex > 0) Or (bCreatingNewFClass And bNewFClassSet)
84:     bValidRequiredFields = (cmbFieldStripMapName.ListIndex > 0) And _
                           (cmbFieldGridAngle.ListIndex > 0) And _
                           (cmbFieldSeriesNumber.ListIndex > 0)
87: i = 2
88:     If bValidTarget And (Not bCreatingNewFClass) Then
89:         Set pFL = FindFeatureLayerByName(cmbPolygonLayers.List(cmbPolygonLayers.ListIndex), m_Application)
90:         If pFL.FeatureClass.FeatureDataset Is Nothing Then
91:             bPolylineWithinDataset = True
92:         Else
93:             Set pDatasetExtent = GetValidExtentForLayer(pFL)
94:             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)
96:         End If
97:     ElseIf bValidTarget And bCreatingNewFClass Then
98:         bPolylineWithinDataset = True
99:     End If
    Dim a As Long, b As Long, c As Long
101:     a = cmbFieldGridAngle.ListIndex
102:     b = cmbFieldMapScale.ListIndex
103:     c = cmbFieldSeriesNumber.ListIndex
104:     bDuplicateFieldsSelected = (a > 0 And (a = b Or a = c)) _
                            Or (b > 0 And (b = c))
106: i = 3
    
    ' Set states
    Select Case m_Step
        Case 0:     ' Set the target feature layer
111:             cmdBack.Enabled = False
112:             cmdNext.Enabled = bValidTarget And bValidName
113:             cmdNext.Caption = "Next >"
114:             cmbPolygonLayers.Enabled = Not bCreatingNewFClass
115:             chkRemovePreviousGrids.Enabled = Not bCreatingNewFClass
116:             lblClearExistingGridsPart2.Enabled = Not bCreatingNewFClass
117:             cmdSetNewGridLayer.Enabled = bCreatingNewFClass
        Case 1:     ' Set the fields to populate
119:             cmdBack.Enabled = True
120:             cmdNext.Enabled = (bValidRequiredFields And Not bDuplicateFieldsSelected)
121:             cmbFieldStripMapName.Enabled = Not bCreatingNewFClass
122:             cmbFieldGridAngle.Enabled = Not bCreatingNewFClass
123:             cmbFieldMapScale.Enabled = Not bCreatingNewFClass
124:             cmbFieldSeriesNumber.Enabled = Not bCreatingNewFClass
        Case 2:     ' Set the scale / starting_coords
126:             cmdBack.Enabled = True
127:             cmdNext.Enabled = bValidScale And bPolylineWithinDataset
128:             cmdNext.Caption = "Next >"
        Case 3:     ' Set the dataframe properties
130:             cmdBack.Enabled = True
131:             cmdNext.Enabled = bValidSize
132:             cmdNext.Caption = "Finish"
133:             txtManualGridHeight.Enabled = Not (optScaleSource(2).Value)
134:             txtManualGridHeight.Locked = (optScaleSource(2).Value)
135:             lblFrameHeight.Enabled = Not (optScaleSource(2).Value)
136:             optGridSize(0).Enabled = Not (optScaleSource(2).Value)
        Case Else:
138:             cmdBack.Enabled = False
139:             cmdNext.Enabled = False
140:     End Select
141: i = 4
    
143:     txtManualMapScale.Enabled = optScaleSource(1).Value
144:     txtManualGridWidth.Enabled = optGridSize(1).Value
145:     txtManualGridHeight.Enabled = optGridSize(1).Value
146:     cmbGridSizeUnits.Enabled = optGridSize(1).Value
147:     If optScaleSource(1).Value Then
148:         If bValidScale Then
149:             txtManualMapScale.ForeColor = (&H0)      ' Black
150:         Else
151:             txtManualMapScale.ForeColor = (&HFF)     ' Red
152:         End If
153:     End If
154:     If optGridSize(1).Value Then
155:         If bValidSize Then
156:             txtManualGridWidth.ForeColor = (&H0)      ' Black
157:             txtManualGridHeight.ForeColor = (&H0)
158:         Else
159:             txtManualGridWidth.ForeColor = (&HFF)     ' Red
160:             txtManualGridHeight.ForeColor = (&HFF)
161:         End If
162:     End If
    
    Exit Sub
165:     Resume
eh:
167:     MsgBox Err.Description, vbExclamation, "SetControlsState " & i
End Sub

Private Sub cmbFieldStripMapName_Click()
171:     SetControlsState
End Sub

Private Sub cmbFieldMapScale_Click()
175:     SetControlsState
End Sub

Private Sub cmbFieldSeriesNumber_Click()
179:     SetControlsState
End Sub

Private Sub cmbFieldGridAngle_Click()
183:     SetControlsState
End Sub

Private Sub cmbPolygonLayers_Click()
    Dim pFL As IFeatureLayer
    Dim pFields As IFields
    Dim lLoop As Long
    ' Populate the fields combo boxes
191:     If cmbPolygonLayers.ListIndex > 0 Then
192:         Set pFL = FindFeatureLayerByName(cmbPolygonLayers.List(cmbPolygonLayers.ListIndex), m_Application)
193:         Set pFields = pFL.FeatureClass.Fields
194:         cmbFieldMapScale.Clear
195:         cmbFieldStripMapName.Clear
196:         cmbFieldSeriesNumber.Clear
197:         cmbFieldGridAngle.Clear
198:         cmbFieldStripMapName.AddItem "<None>"
199:         cmbFieldGridAngle.AddItem "<None>"
200:         cmbFieldMapScale.AddItem "<None>"
201:         cmbFieldSeriesNumber.AddItem "<None>"
202:         For lLoop = 0 To pFields.FieldCount - 1
203:             If pFields.Field(lLoop).Type = esriFieldTypeString Then
204:                 cmbFieldStripMapName.AddItem pFields.Field(lLoop).Name
205:             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
209:                 cmbFieldMapScale.AddItem pFields.Field(lLoop).Name
210:                 cmbFieldGridAngle.AddItem pFields.Field(lLoop).Name
211:                 cmbFieldSeriesNumber.AddItem pFields.Field(lLoop).Name
212:             End If
213:         Next
214:         cmbFieldStripMapName.ListIndex = 0
215:         cmbFieldGridAngle.ListIndex = 0
216:         cmbFieldMapScale.ListIndex = 0
217:         cmbFieldSeriesNumber.ListIndex = 0
218:     End If
219:     SetControlsState
End Sub

Private Sub cmdBack_Click()
223:     m_Step = m_Step - 1
224:     If m_Step < 0 Then
225:         m_Step = 0