frmcalculatecorrelation.frm

GIS二次开发,主要是结合AE和VB做的实验开原代码

VERSION 5.00
Begin VB.Form frmCalculateCorrelation 
   Caption         =   "Calculate Correlation"
   ClientHeight    =   3780
   ClientLeft      =   45
   ClientTop       =   300
   ClientWidth     =   5175
   LinkTopic       =   "Form1"
   ScaleHeight     =   3780
   ScaleWidth      =   5175
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtErrField 
      Height          =   285
      Left            =   360
      TabIndex        =   16
      Text            =   "ErrorTerm"
      Top             =   1800
      Width           =   3255
   End
   Begin VB.TextBox txtSlope 
      Appearance      =   0  'Flat
      Height          =   288
      Left            =   3720
      Locked          =   -1  'True
      TabIndex        =   12
      Top             =   3240
      Width           =   1092
   End
   Begin VB.TextBox txtIntercept 
      Appearance      =   0  'Flat
      Height          =   288
      Left            =   1440
      Locked          =   -1  'True
      TabIndex        =   11
      Top             =   3240
      Width           =   1092
   End
   Begin VB.TextBox txtR2 
      Appearance      =   0  'Flat
      Height          =   288
      Left            =   1440
      Locked          =   -1  'True
      TabIndex        =   10
      Top             =   2880
      Width           =   1092
   End
   Begin VB.ComboBox cboXField 
      Height          =   315
      Left            =   360
      TabIndex        =   5
      Text            =   "Combo1"
      Top             =   360
      Width           =   3300
   End
   Begin VB.ComboBox cboYField 
      Height          =   315
      Left            =   360
      TabIndex        =   4
      Text            =   "Combo2"
      Top             =   1080
      Width           =   3300
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "Apply"
      Height          =   372
      Left            =   2640
      TabIndex        =   3
      Top             =   2280
      Width           =   1092
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   372
      Left            =   3840
      TabIndex        =   2
      Top             =   2280
      Width           =   1092
   End
   Begin VB.TextBox txtXExclude 
      Alignment       =   1  'Right Justify
      Height          =   288
      Left            =   3720
      TabIndex        =   1
      Text            =   "-99"
      Top             =   360
      Width           =   1092
   End
   Begin VB.TextBox txtYExclude 
      Alignment       =   1  'Right Justify
      Height          =   288
      Left            =   3720
      TabIndex        =   0
      Text            =   "-99"
      Top             =   1080
      Width           =   1092
   End
   Begin VB.Label Label7 
      Caption         =   "Enter a field name to store the error term in your table"
      Height          =   255
      Left            =   360
      TabIndex        =   17
      Top             =   1560
      Width           =   3855
   End
   Begin VB.Label Label6 
      Caption         =   "Slope"
      Height          =   255
      Left            =   2640
      TabIndex        =   15
      Top             =   3240
      Width           =   975
   End
   Begin VB.Label Label5 
      Caption         =   "Y Intercept"
      Height          =   255
      Left            =   360
      TabIndex        =   14
      Top             =   3240
      Width           =   975
   End
   Begin VB.Label Label4 
      Caption         =   "R Squared"
      Height          =   255
      Left            =   360
      TabIndex        =   13
      Top             =   2880
      Width           =   975
   End
   Begin VB.Label lblXField 
      Caption         =   "Select a field for the independent variable"
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   120
      Width           =   3120
   End
   Begin VB.Label Label1 
      Caption         =   "Select a field for the dependent variable"
      Height          =   255
      Left            =   360
      TabIndex        =   8
      Top             =   840
      Width           =   3120
   End
   Begin VB.Label Label2 
      Caption         =   "Exclude Values"
      Height          =   255
      Left            =   3720
      TabIndex        =   7
      Top             =   120
      Width           =   1200
   End
   Begin VB.Label Label3 
      Caption         =   "Exclude Values"
      Height          =   255
      Left            =   3720
      TabIndex        =   6
      Top             =   840
      Width           =   1200
   End
End
Attribute VB_Name = "frmCalculateCorrelation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 1995-2005 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

Private m_pMxDocument As IMxDocument
Private m_pSourceLayer As IFeatureLayer

Public Property Set MxDocument(RHS As IMxDocument)
  Set m_pMxDocument = RHS

End Property

Public Property Get MxDocument() As IMxDocument
  Set MxDocument = m_pMxDocument

End Property

Public Property Set SourceLayer(RHS As IFeatureLayer)
  Set m_pSourceLayer = RHS

End Property

Public Property Get SourceLayer() As IFeatureLayer
  Set SourceLayer = m_pSourceLayer

End Property

Private Sub updateFieldList(cboList As Control)
  'This adds all of the appropriate fields to the combo box controls
  'that allow the user to select fields to correlate with one another
  Dim i As Integer
  Dim pMxDoc As IMxDocument
  Dim pFeatureLayer As IFeatureLayer
  
  cboList.Clear
  
  Set pMxDoc = m_pMxDocument
  Set pFeatureLayer = m_pSourceLayer
  
  Dim pDisTable As IDisplayTable
  Dim pTable As ITable
  Dim pFields As IFields
  Dim pField As IField
  Dim pTableFields As ITableFields
  
  Set pDisTable = pFeatureLayer
  Set pTable = pDisTable.DisplayTable
  Set pFields = pTable.Fields
  Set pTableFields = pFeatureLayer
  
  For i = 0 To (pTableFields.FieldCount - 1)
    Set pField = pTableFields.Field(i)
    If pField.Type < 4 Then 'All field types <4 are numeric
      cboList.AddItem pTableFields.FieldInfo(i).Alias
    End If
  Next i
End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub

Private Sub cmdOK_Click()
  On Error GoTo ErrorHandler
  Dim pReg As BivariateRegressor
  Dim pAttTable As IAttributeTable
  Dim pTable As ITable
  
  'Create a new bivariate regressor
  Set pReg = New BivariateRegressor
  
  Set pAttTable = m_pSourceLayer
  Set pTable = pAttTable.AttributeTable
  
  'Set the table containing the data to be correlated
  Set pReg.SourceTable = pTable
  
  'Set a field that will hold the residual values
  pReg.ErrField = txtErrField.Text
  
  'Set the fields to be correlated
  pReg.XField = cboXField.Text
  pReg.YField = cboYField.Text
  
  'Set values to be excluded from the correlation calculation
  pReg.XExclude = txtXExclude.Text
  pReg.YExclude = txtYExclude.Text
  
  'Run the correlation, and report the results
  txtR2.Text = pReg.RSquared
  txtIntercept.Text = pReg.YIntercept
  txtSlope.Text = pReg.slope
  
  GoTo EndProc
ErrorHandler:
  MsgBox "Apply Error: " & Err.Number & "  " & Err.Description
EndProc:
End Sub

Private Sub Form_Load()
  updateFieldList cboXField
  updateFieldList cboYField
  cboXField.ListIndex = 0
  cboYField.ListIndex = 1
End Sub