frmgridsettings.frm

一个不错的插件

End Sub

Private Sub optLayerSource_Click(Index As Integer)
    ' If creating a new fclass to hold the grids
674:     If Index = 1 Then
        ' Set the field names (will be created automatically)
676:         cmbFieldID.Clear
677:         cmbFieldRowNum.Clear
678:         cmbFieldColNum.Clear
679:         cmbFieldMapScale.Clear
680:         cmbFieldID.AddItem "<None>"
681:         cmbFieldRowNum.AddItem "<None>"
682:         cmbFieldColNum.AddItem "<None>"
683:         cmbFieldMapScale.AddItem "<None>"
684:         cmbFieldID.AddItem c_DefaultFld_GridID
685:         cmbFieldRowNum.AddItem c_DefaultFld_RowNum
686:         cmbFieldColNum.AddItem c_DefaultFld_ColNum
687:         cmbFieldMapScale.AddItem c_DefaultFld_Scale
688:         cmbFieldID.ListIndex = 1
689:         cmbFieldRowNum.ListIndex = 1
690:         cmbFieldColNum.ListIndex = 1
691:         cmbFieldMapScale.ListIndex = 1
692:     End If
693:     SetControlsState
End Sub

Private Sub optRowIDType_Click(Index As Integer)
697:     lblExampleID.Caption = GenerateExampleID
698:     SetControlsState
End Sub

Private Function GenerateExampleID() As String
    Dim sRow As String, sCol As String
703:     If optStartingIDPosition(0).value Then  'Top left
704:         If (optRowIDType(0).value) Then
705:             sRow = "A"
706:         Else
707:             sRow = "1"
708:         End If
709:         If (optColIDType(0).value) Then
710:             sCol = "C"
711:         Else
712:             sCol = "3"
713:         End If
714:     Else                                    ' Lower left
715:         If (optRowIDType(0).value) Then
716:             sRow = "C"
717:         Else
718:             sRow = "3"
719:         End If
720:         If (optColIDType(0).value) Then
721:             sCol = "C"
722:         Else
723:             sCol = "3"
724:         End If
725:     End If
726:     If (optGridIDOrder(0).value) Then
727:         If chkBreak.value = vbChecked Then
728:             GenerateExampleID = sRow & "_" & sCol
729:         Else
730:             GenerateExampleID = sRow & sCol
731:         End If
732:     Else
733:         If chkBreak.value = vbChecked Then
734:             GenerateExampleID = sCol & "_" & sRow
735:         Else
736:             GenerateExampleID = sCol & sRow
737:         End If
738:     End If
End Function

Private Sub optScaleSource_Click(Index As Integer)
742:     If Index = 0 Then
743:         SetCurrentMapScaleCaption
744:     End If
745:     SetControlsState
End Sub

Private Sub optStartingIDPosition_Click(Index As Integer)
749:     lblExampleID.Caption = GenerateExampleID
750:     SetControlsState
End Sub

Private Sub txtEndCoordX_Change()
754:     SetControlsState
End Sub

Private Sub txtEndCoordX_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
759:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
763:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
765:     ElseIf KeyAscii = Asc(".") Then
766:         If InStr(txtEndCoordX.Text, ".") > 0 Then
767:             KeyAscii = 0
768:         End If
769:     End If
End Sub

Private Sub txtEndCoordY_Change()
773:     SetControlsState
End Sub

Private Sub txtEndCoordY_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
778:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
782:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
784:     ElseIf KeyAscii = Asc(".") Then
785:         If InStr(txtEndCoordY.Text, ".") > 0 Then
786:             KeyAscii = 0
787:         End If
788:     End If
End Sub

Private Sub txtManualGridHeight_Change()
792:     SetControlsState
End Sub

Private Sub txtManualGridHeight_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
797:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
801:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
803:     ElseIf KeyAscii = Asc(".") Then
804:         If InStr(txtManualGridHeight.Text, ".") > 0 Then
805:             KeyAscii = 0
806:         End If
807:     End If
End Sub

Private Sub txtManualGridWidth_Change()
811:     SetControlsState
End Sub

Private Sub txtManualGridWidth_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
816:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
820:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
822:     ElseIf KeyAscii = Asc(".") Then
823:         If InStr(txtManualGridWidth.Text, ".") > 0 Then
824:             KeyAscii = 0
825:         End If
826:     End If
End Sub

Private Sub txtManualMapScale_Change()
830:     SetControlsState
End Sub

Private Sub txtManualMapScale_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
835:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
839:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
841:     ElseIf KeyAscii = Asc(".") Then
842:         If InStr(txtManualMapScale.Text, ".") > 0 Then
843:             KeyAscii = 0
844:         End If
845:     End If
End Sub

Public Sub Tickle()
849:     Call Form_Load
End Sub

Private Sub txtStartCoordX_Change()
853:     SetControlsState
End Sub

Private Sub txtStartCoordX_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
858:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
862:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
864:     ElseIf KeyAscii = Asc(".") Then
865:         If InStr(txtStartCoordX.Text, ".") > 0 Then
866:             KeyAscii = 0
867:         End If
868:     End If
End Sub

Private Sub txtStartCoordY_Change()
872:     SetControlsState
End Sub

Private Sub txtStartCoordY_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
877:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
881:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
883:     ElseIf KeyAscii = Asc(".") Then
884:         If InStr(txtStartCoordY.Text, ".") > 0 Then
885:             KeyAscii = 0
886:         End If
887:     End If
End Sub

Private Sub SetVisibleControls(iStep As Integer)
    ' Hide all
892:     fraAttributes.Visible = False
893:     fraDataFrameSize.Visible = False
894:     fraDestinationFeatureClass.Visible = False
895:     fraGridIDs.Visible = False
896:     fraScaleStart.Visible = False
    ' Show applicable frame, set top/left
    Select Case iStep
        Case 0:
900:             fraDestinationFeatureClass.Visible = True
901:             fraDestinationFeatureClass.Top = 0
902:             fraDestinationFeatureClass.Left = 0
        Case 1:
904:             fraAttributes.Visible = True
905:             fraAttributes.Top = 0
906:             fraAttributes.Left = 0
        Case 2:
908:             fraScaleStart.Visible = True
909:             fraScaleStart.Top = 0
910:             fraScaleStart.Left = 0
        Case 3:
912:             fraDataFrameSize.Visible = True
913:             fraDataFrameSize.Top = 0
914:             fraDataFrameSize.Left = 0
        Case 4:
916:             fraGridIDs.Visible = True
917:             fraGridIDs.Top = 0
918:             fraGridIDs.Left = 0
        Case Else:
920:             MsgBox "Invalid Step Value."
921:     End Select
End Sub

Private Sub CheckOutputFile()
    'Check the output option
926:     If txtNewGridLayer.Text <> "" Then
927:         If DoesShapeFileExist(txtNewGridLayer.Text) Then
928:             MsgBox "Shape file name already being used!!!"
929:             txtNewGridLayer.Text = ""
930:         End If
931:     End If
End Sub

Private Function CreateTheFields() As IFields
    Dim newField As IField
    Dim newFieldEdit As IFieldEdit
    Dim pNewFields As IFields
    Dim pFieldsEdit As IFieldsEdit
    Dim pGeomDef As IGeometryDef
    Dim pGeomDefEdit As IGeometryDefEdit
    Dim pMx As IMxDocument
    
    ' Init
944:     Set pNewFields = New Fields
945:     Set pFieldsEdit = pNewFields
946:     Set pMx = m_Application.Document
    ' Field: OID
948:     Set newField = New Field
949:     Set newFieldEdit = newField
950:     With newFieldEdit
951:         .Name = "OID"
952:         .Type = esriFieldTypeOID
953:         .AliasName = "Object ID"
954:         .IsNullable = False
955:     End With
956:     pFieldsEdit.AddField newField
    'Set pFieldsEdit.Field(0) = pFieldEdit
    
'    ' Field: SHAPE
'    Set newField = New Field
'    Set newFieldEdit = newField
'    newFieldEdit.Name = c_DefaultFld_Shape
'    newFieldEdit.Type = esriFieldTypeGeometry
'    Set pGeomDef = New GeometryDef
'    Set pGeomDefEdit = pGeomDef
'    With pGeomDefEdit
'        .GeometryType = esriGeometryPolygon
'        Set .SpatialReference = pMx.FocusMap.SpatialReference ' New UnknownCoordinateSystem
'    End With
'    Set newFieldEdit.GeometryDef = pGeomDef
'    pFieldsEdit.AddField newField
    ' Field: GRID IDENTIFIER
973:     Set newField = New Field
974:     Set newFieldEdit = newField
975:     With newFieldEdit
976:       .Name = c_DefaultFld_GridID
977:       .AliasName = "GridIdentifier"
978:       .Type = esriFieldTypeString
979:       .IsNullable = True
980:       .length = 50
981:     End With
982:     pFieldsEdit.AddField newField
    ' Field: ROW NUMBER
984:     Set newField = New Field
985:     Set newFieldEdit = newField
986:     With newFieldEdit
987:       .Name = c_DefaultFld_RowNum
988:       .AliasName = "Row Number"
989:       .Type = esriFieldTypeInteger
990:       .IsNullable = True
991:     End With
992:     pFieldsEdit.AddField newField
    ' Field: COLUMN NUMBER
994:     Set newField = New Field
995:     Set newFieldEdit = newField
996:     With newFieldEdit
997:       .Name = c_DefaultFld_ColNum
998:       .AliasName = "Column Number"
999:       .Type = esriFieldTypeInteger
1000:       .IsNullable = True
1001:     End With
1002:     pFieldsEdit.AddField newField
    ' Field: SCALE
1004:     Set newField = New Field
1005:     Set newFieldEdit = newField
1006:     With newFieldEdit
1007:       .Name = c_DefaultFld_Scale
1008:       .AliasName = "Plot Scale"
1009:       .Type = esriFieldTypeDouble
1010:       .IsNullable = True
1011:       .Precision = 18
1012:       .Scale = 11
1013:     End With
1014:     pFieldsEdit.AddField newField
    ' Return
1016:     Set CreateTheFields = pFieldsEdit
End Function