clscreategrids.cls

一个不错的插件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCreateGrids"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

' 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

'----------------------------------------------
' Properties
' - DestinationFeatureClass (IFeatureClass, r/w)
' - MapScale (Double, r/w)
' - FrameWidthInPageUnits (Double, r/w)
' - FrameHeightInPageUnits (Double, r/w)
' - IdentifierOrder (mgGridIdentifierOrderType, r/w)
' - RowIDType (mgGridIdentifierValueType, r/w)
' - ColIDType (mgGridIdentifierValueType, r/w)
' - StartingCoordinateLL_X (Double, r/w)
' - StartingCoordinateLL_Y (Double, r/w)
' - EndingCoordinateUR_X (Double, r/w)
' - EndingCoordinateUR_Y (Double, r/w)
' - UseUnderscore (Boolean, r/w)
'----------------------------------------------
' Methods
' - GenerateGrids(pApp as IApplication)
'    : Generates the grids using the values added.
' - RunStandardGUI(pApp as IApplication)
'    : To open the form without having the button
'      added to ArcMap's GUI.
'----------------------------------------------
' Enumerated Types
Public Enum mgGridIdentifierOrderType
    Row_Column = 0
    Column_Row = 1
End Enum
Public Enum mgGridIdentifierValueType
    Alphabetical = 0
    Numerical = 1
End Enum
Public Enum mgGridIdentifierStartPositionType
    TopLeft = 0
    LowerLeft = 1
End Enum
'----------------------------------------------
' Local Global Declarations
Private m_DestFL As IFeatureLayer
Private m_DestFC As IFeatureClass
Private m_dMapScale As Double
Private m_dFrameWidthInPageUnits As Double
Private m_dFrameHeightInPageUnits As Double
Private m_IDOrderType As mgGridIdentifierOrderType
Private m_RowIDType As mgGridIdentifierValueType
Private m_ColIDType As mgGridIdentifierValueType
Private m_StartIDType As mgGridIdentifierStartPositionType
Private m_StartX As Double
Private m_StartY As Double
Private m_EndX As Double
Private m_EndY As Double
Private m_UseUnderscore As Boolean
Private m_colLayerNamesForData As Collection
Private m_FldID As String
Private m_FldRowNum As String
Private m_FldColNum As String
Private m_FldScale As String
Private m_RemoveGrids As Boolean
Private m_NoEmptyGrids As Boolean
Private m_pProgress As IModelessFrame

'----------------------------------------------
' API call to keep form top most
Private Const GWL_HWNDPARENT = -8
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Property Set DestinationFeatureLayer(pFL As IFeatureLayer)
82:     If pFL.FeatureClass.ShapeType = esriGeometryPolygon Then
83:         Set m_DestFL = pFL
84:         Set m_DestFC = pFL.FeatureClass
85:     Else
86:         Err.Raise vbObjectError, "MapGridManager_Set_DestinationFeatureLayer", _
            "Not a polygon feature layer"
88:     End If
End Property

Public Property Get DestinationFeatureLayer() As IFeatureLayer
92:     Set DestinationFeatureLayer = m_DestFL
End Property

Public Property Let FrameWidthInPageUnits(dWidth As Double)
96:     m_dFrameWidthInPageUnits = dWidth
End Property

Public Property Get FrameWidthInPageUnits() As Double
100:     FrameWidthInPageUnits = m_dFrameWidthInPageUnits
End Property

Public Property Let FrameHeightInPageUnits(dHeight As Double)
104:     m_dFrameHeightInPageUnits = dHeight
End Property

Public Property Get FrameHeightInPageUnits() As Double
108:     FrameHeightInPageUnits = m_dFrameHeightInPageUnits
End Property

Public Property Let MapScale(dScale As Double)
112:     m_dMapScale = dScale
End Property

Public Property Get MapScale() As Double
116:     MapScale = m_dMapScale
End Property

Public Property Let IdentifierOrder(mgType As mgGridIdentifierOrderType)
120:     m_IDOrderType = mgType
End Property

Public Property Get IdentifierOrder() As mgGridIdentifierOrderType
124:     IdentifierOrder = m_IDOrderType
End Property

Public Property Let RowIDType(mgIDStyle As mgGridIdentifierValueType)
128:     m_RowIDType = mgIDStyle
End Property

Public Property Get RowIDType() As mgGridIdentifierValueType
132:     RowIDType = m_RowIDType
End Property

Public Property Let ColIDType(mgIDStyle As mgGridIdentifierValueType)
136:     m_ColIDType = mgIDStyle
End Property

Public Property Get ColIDType() As mgGridIdentifierValueType
140:     ColIDType = m_ColIDType
End Property

Public Property Let IDStartPositionType(mgStartPos As mgGridIdentifierStartPositionType)
144:     m_StartIDType = mgStartPos
End Property

Public Property Get IDStartPositionType() As mgGridIdentifierStartPositionType
148:     IDStartPositionType = m_StartIDType
End Property

Public Property Let StartingCoordinateLL_X(X As Double)
152:     m_StartX = X
End Property

Public Property Get StartingCoordinateLL_X() As Double
156:     StartingCoordinateLL_X = m_StartX
End Property

Public Property Let StartingCoordinateLL_Y(Y As Double)
160:     m_StartY = Y
End Property

Public Property Get StartingCoordinateLL_Y() As Double
164:     StartingCoordinateLL_Y = m_StartY
End Property

Public Property Let EndingCoordinateUR_X(X As Double)
168:     m_EndX = X
End Property

Public Property Get EndingCoordinateUR_X() As Double
172:     EndingCoordinateUR_X = m_EndX
End Property

Public Property Let EndingCoordinateUR_Y(Y As Double)
176:     m_EndY = Y
End Property

Public Property Get EndingCoordinateUR_Y() As Double
180:     EndingCoordinateUR_Y = m_EndY
End Property

Public Property Let FieldNameGridID(FieldName As String)
184:     m_FldID = FieldName
End Property

Public Property Let FieldNameRowNum(FieldName As String)
188:     m_FldRowNum = FieldName
End Property

Public Property Let FieldNameColNum(FieldName As String)
192:     m_FldColNum = FieldName
End Property

Public Property Let FieldNameScale(FieldName As String)
196:     m_FldScale = FieldName
End Property

Public Property Let UseUnderscore(UseUnderscoreInID As Boolean)
200:     m_UseUnderscore = UseUnderscoreInID
End Property

Public Property Get UseUnderscore() As Boolean
204:     UseUnderscore = m_UseUnderscore
End Property

Public Property Let RemoveCurrentGrids(RemoveGrids As Boolean)
208:     m_RemoveGrids = RemoveGrids
End Property

Public Property Get RemoveCurrentGrids() As Boolean
212:     RemoveCurrentGrids = m_RemoveGrids
End Property

Public Property Let NoEmptyGrids(NoEmptyGridPolygons As Boolean)
216:     m_NoEmptyGrids = NoEmptyGridPolygons
End Property

Public Property Get NoEmptyGrids() As Boolean
220:     NoEmptyGrids = m_NoEmptyGrids
End Property

Public Sub AddRequiredDataLayer(sLayerName As String)
224:     m_colLayerNamesForData.Add sLayerName
End Sub

Public Property Get RequiredDataLayer(LayerNumber As Long) As String
228:     If LayerNumber <= m_colLayerNamesForData.count Then
229:         RequiredDataLayer = m_colLayerNamesForData.Item(LayerNumber - 1)
230:     Else
231:         If m_colLayerNamesForData.count = 0 Then
232:             RequiredDataLayer = "There are no Required Data Layers."
233:         Else
234:             RequiredDataLayer = "Invalid layer number.  Valid range: 0 - " & (m_colLayerNamesForData.count - 1)
235:         End If
236:     End If
End Property

Public Property Get RequiredDataLayerCount() As Long
240:     RequiredDataLayerCount = m_colLayerNamesForData.count
End Property

Public Sub ClearRequiredDataLayers()
244:     Set m_colLayerNamesForData = New Collection
End Sub

Private Sub Class_Initialize()
    ' Set the default grid identifier (row-col, alpha/numeric => eg: "B02")
249:     m_IDOrderType = Row_Column
250:     m_RowIDType = Alphabetical
251:     m_ColIDType = Numerical
252:     Set m_colLayerNamesForData = New Collection
253:     Set m_pProgress = New ModelessFrame
End Sub

Private Function CalculateID(ByVal lRow As Long, ByVal lCol As Long, _
                             ByVal iRowIDLen As Integer, ByVal iColIDLen As Integer) As String
    Dim sRowID As String
    Dim sColID As String
    Dim sNumericFormat As String
    Dim lLoop As Long
    Dim lTmp As Long, lCalc As Long, lTmp2 As Long

    ' Row ---------------------------------------------
265:     sNumericFormat = ""
266:     For lLoop = 1 To iRowIDLen
267:         sNumericFormat = sNumericFormat & "0"
268:     Next
269:     If m_RowIDType = Alphabetical Then
270:         For lLoop = 1 To iRowIDLen
271:             lTmp = 26 ^ lLoop
272:             lTmp2 = (26 ^ (lLoop - 1))
273:             If lRow >= lTmp2 Then
274:                 lCalc = ((((lRow - lTmp2) / lTmp) * 26) + 1) Mod 26
275:                 sRowID = Chr(Asc("A") + lCalc) & sRowID
276:                 lRow = lRow - (lCalc * lTmp2)