frmgridsettings.frm

使用VB和ArcObject结合的程序

    Dim pMx As IMxDocument
655:     Set pMx = m_Application.Document
656:     lblCurrFrameName.Caption = pMx.FocusMap.Name
657:     SetControlsState
End Sub

Private Sub optLayerSource_Click(Index As Integer)
    ' If creating a new fclass to hold the grids
662:     If Index = 1 Then
        ' Set the field names (will be created automatically)
664:         cmbFieldID.Clear
665:         cmbFieldRowNum.Clear
666:         cmbFieldColNum.Clear
667:         cmbFieldMapScale.Clear
668:         cmbFieldID.AddItem "<None>"
669:         cmbFieldRowNum.AddItem "<None>"
670:         cmbFieldColNum.AddItem "<None>"
671:         cmbFieldMapScale.AddItem "<None>"
672:         cmbFieldID.AddItem c_DefaultFld_GridID
673:         cmbFieldRowNum.AddItem c_DefaultFld_RowNum
674:         cmbFieldColNum.AddItem c_DefaultFld_ColNum
675:         cmbFieldMapScale.AddItem c_DefaultFld_Scale
676:         cmbFieldID.ListIndex = 1
677:         cmbFieldRowNum.ListIndex = 1
678:         cmbFieldColNum.ListIndex = 1
679:         cmbFieldMapScale.ListIndex = 1
680:     End If
681:     SetControlsState
End Sub

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

Private Function GenerateExampleID() As String
    Dim sRow As String, sCol As String
691:     If optStartingIDPosition(0).Value Then  'Top left
692:         If (optRowIDType(0).Value) Then
693:             sRow = "A"
694:         Else
695:             sRow = "1"
696:         End If
697:         If (optColIDType(0).Value) Then
698:             sCol = "C"
699:         Else
700:             sCol = "3"
701:         End If
702:     Else                                    ' Lower left
703:         If (optRowIDType(0).Value) Then
704:             sRow = "C"
705:         Else
706:             sRow = "3"
707:         End If
708:         If (optColIDType(0).Value) Then
709:             sCol = "C"
710:         Else
711:             sCol = "3"
712:         End If
713:     End If
714:     If (optGridIDOrder(0).Value) Then
715:         If chkBreak.Value = vbChecked Then
716:             GenerateExampleID = sRow & "_" & sCol
717:         Else
718:             GenerateExampleID = sRow & sCol
719:         End If
720:     Else
721:         If chkBreak.Value = vbChecked Then
722:             GenerateExampleID = sCol & "_" & sRow
723:         Else
724:             GenerateExampleID = sCol & sRow
725:         End If
726:     End If
End Function

Private Sub optScaleSource_Click(Index As Integer)
730:     If Index = 0 Then
731:         SetCurrentMapScaleCaption
732:     End If
733:     SetControlsState
End Sub

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

Private Sub txtEndCoordX_Change()
742:     SetControlsState
End Sub

Private Sub txtEndCoordX_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
747:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
751:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
753:     ElseIf KeyAscii = Asc(".") Then
754:         If InStr(txtEndCoordX.Text, ".") > 0 Then
755:             KeyAscii = 0
756:         End If
757:     End If
End Sub

Private Sub txtEndCoordY_Change()
761:     SetControlsState
End Sub

Private Sub txtEndCoordY_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
766:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
770:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
772:     ElseIf KeyAscii = Asc(".") Then
773:         If InStr(txtEndCoordY.Text, ".") > 0 Then
774:             KeyAscii = 0
775:         End If
776:     End If
End Sub

Private Sub txtManualGridHeight_Change()
780:     SetControlsState
End Sub

Private Sub txtManualGridHeight_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
785:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
789:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
791:     ElseIf KeyAscii = Asc(".") Then
792:         If InStr(txtManualGridHeight.Text, ".") > 0 Then
793:             KeyAscii = 0
794:         End If
795:     End If
End Sub

Private Sub txtManualGridWidth_Change()
799:     SetControlsState
End Sub

Private Sub txtManualGridWidth_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
804:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
808:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
810:     ElseIf KeyAscii = Asc(".") Then
811:         If InStr(txtManualGridWidth.Text, ".") > 0 Then
812:             KeyAscii = 0
813:         End If
814:     End If
End Sub

Private Sub txtManualMapScale_Change()
818:     SetControlsState
End Sub

Private Sub txtManualMapScale_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
823:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
827:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
829:     ElseIf KeyAscii = Asc(".") Then
830:         If InStr(txtManualMapScale.Text, ".") > 0 Then
831:             KeyAscii = 0
832:         End If
833:     End If
End Sub

Public Sub Tickle()
837:     Call Form_Load
End Sub

Private Sub txtStartCoordX_Change()
841:     SetControlsState
End Sub

Private Sub txtStartCoordX_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
846:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
850:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
852:     ElseIf KeyAscii = Asc(".") Then
853:         If InStr(txtStartCoordX.Text, ".") > 0 Then
854:             KeyAscii = 0
855:         End If
856:     End If
End Sub

Private Sub txtStartCoordY_Change()
860:     SetControlsState
End Sub

Private Sub txtStartCoordY_KeyPress(KeyAscii As Integer)
    ' If a non-numeric (that is not a decimal point)
865:     If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) _
     And KeyAscii <> Asc(".") _
     And Chr(KeyAscii) <> vbBack Then
        ' Do not allow this button to work
869:         KeyAscii = 0
    ' If a decimal point, make sure we only ever get one of them
871:     ElseIf KeyAscii = Asc(".") Then
872:         If InStr(txtStartCoordY.Text, ".") > 0 Then
873:             KeyAscii = 0
874:         End If
875:     End If
End Sub

Private Sub SetVisibleControls(iStep As Integer)
    ' Hide all
880:     fraAttributes.Visible = False
881:     fraDataFrameSize.Visible = False
882:     fraDestinationFeatureClass.Visible = False
883:     fraGridIDs.Visible = False
884:     fraScaleStart.Visible = False
    ' Show applicable frame, set top/left
    Select Case iStep
        Case 0:
888:             fraDestinationFeatureClass.Visible = True
889:             fraDestinationFeatureClass.Top = 0
890:             fraDestinationFeatureClass.Left = 0
        Case 1:
892:             fraAttributes.Visible = True
893:             fraAttributes.Top = 0
894:             fraAttributes.Left = 0
        Case 2:
896:             fraScaleStart.Visible = True
897:             fraScaleStart.Top = 0
898:             fraScaleStart.Left = 0
        Case 3:
900:             fraDataFrameSize.Visible = True
901:             fraDataFrameSize.Top = 0
902:             fraDataFrameSize.Left = 0
        Case 4:
904:             fraGridIDs.Visible = True
905:             fraGridIDs.Top = 0
906:             fraGridIDs.Left = 0
        Case Else:
908:             MsgBox "Invalid Step Value."
909:     End Select
End Sub

Private Sub CheckOutputFile()
    'Check the output option
914:     If txtNewGridLayer.Text <> "" Then
915:         If DoesShapeFileExist(txtNewGridLayer.Text) Then
916:             MsgBox "Shape file name already being used!!!"
917:             txtNewGridLayer.Text = ""
918:         End If
919:     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
932:     Set pNewFields = New Fields
933:     Set pFieldsEdit = pNewFields
934:     Set pMx = m_Application.Document
    ' Field: OID
936:     Set newField = New Field
937:     Set newFieldEdit = newField
938:     With newFieldEdit
939:         .Name = "OID"
940:         .Type = esriFieldTypeOID
941:         .AliasName = "Object ID"
942:         .IsNullable = False
943:     End With
944:     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
961:     Set newField = New Field
962:     Set newFieldEdit = newField
963:     With newFieldEdit
964:       .Name = c_DefaultFld_GridID
965:       .AliasName = "GridIdentifier"
966:       .Type = esriFieldTypeString
967:       .IsNullable = True
968:       .Length = 50
969:     End With
970:     pFieldsEdit.AddField newField
    ' Field: ROW NUMBER
972:     Set newField = New Field
973:     Set newFieldEdit = newField
974:     With newFieldEdit
975:       .Name = c_DefaultFld_RowNum
976:       .AliasName = "Row Number"
977:       .Type = esriFieldTypeInteger
978:       .IsNullable = True
979:     End With
980:     pFieldsEdit.AddField newField
    ' Field: COLUMN NUMBER
982:     Set newField = New Field
983:     Set newFieldEdit = newField
984:     With newFieldEdit
985:       .Name = c_DefaultFld_ColNum
986:       .AliasName = "Column Number"
987:       .Type = esriFieldTypeInteger
988:       .IsNullable = True
989:     End With
990:     pFieldsEdit.AddField newField
    ' Field: SCALE
992:     Set newField = New Field
993:     Set newFieldEdit = newField
994:     With newFieldEdit
995:       .Name = c_DefaultFld_Scale
996:       .AliasName = "Plot Scale"
997:       .Type = esriFieldTypeDouble
998:       .IsNullable = True
999:       .Precision = 18
1000:       .Scale = 11
1001:     End With
1002:     pFieldsEdit.AddField newField
    ' Return
1004:     Set CreateTheFields = pFieldsEdit
End Function