frmstatisticneighbour.frm

超图网络分析扩展的VB开发程序的应用,对地理信息系统开发有益

         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   645
         Width           =   2100
      End
      Begin VB.ComboBox cmbDsList 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   255
         Width           =   2100
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据集："
         Height          =   195
         Index           =   1
         Left            =   345
         TabIndex        =   4
         Top             =   645
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据源："
         Height          =   195
         Index           =   0
         Left            =   340
         TabIndex        =   3
         Top             =   330
         Width           =   720
      End
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   435
      Left            =   4275
      TabIndex        =   33
      Top             =   3810
      Width           =   945
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   435
      Left            =   3165
      TabIndex        =   34
      Top             =   3810
      Width           =   945
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   4260
      Left            =   60
      Picture         =   "frmStatisticNeighbour.frx":003E
      Stretch         =   -1  'True
      Top             =   0
      Width           =   1830
   End
End
Attribute VB_Name = "frmStatisticNeighbour"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmbDsList_Click()
    If cmbDsList.Text = "" Then Exit Sub
    If frmMain.bActiveFrm Then
        ChangeDs cmbDsList.Text, cmbDtList
    End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdMod_Click()
    frameSet.Left = 1950
    frameSet.Top = 50
    frameSet.Visible = True
End Sub

Private Sub cmdOk_Click()
    Dim objDs As soDataSource
    Dim objDtRst As soDatasetRaster
    Dim objGridAnalystEx As soGridAnalystEx
    Dim objStatisticOperator As soStatisticOperator
    Dim objNeighborhoodParam As New soNeighborhoodParam
    Dim AnLysType As seAnalysisUnitsType
    Dim staMode As seStatisticMode
    Dim strTmp As String
    Dim bIgnor As Boolean
    
    Set objDs = frmMain.SuperWorkspace.Datasources(cmbDsList.Text)
    Set objDtRst = objDs.Datasets(cmbDtList.Text)
    Set objDs = frmMain.SuperWorkspace.Datasources(cmbDsListResult.Text)
    strTmp = DataSetName(objDs, txtDataset.Text)
    If strTmp <> "" Then
        Set objGridAnalystEx = frmMain.SuperAnalyst.GridAnalyst
        Set objStatisticOperator = objGridAnalystEx.Statistics
        If optDl.Value Then
            AnLysType = scuUnitsMap
        Else
            AnLysType = scuUnitsCell
        End If
        If optRect.Value Then
            objNeighborhoodParam.SetRectangle CDbl(txtWidth.Text), CDbl(txtLength.Text), AnLysType
        ElseIf optCircle.Value Then
            objNeighborhoodParam.SetCircle CDbl(txtDistance.Text), AnLysType
        ElseIf optRound.Value Then
            objNeighborhoodParam.SetAnnulus CDbl(txtLength.Text), CDbl(txtWidth.Text), AnLysType
        Else
            objNeighborhoodParam.SetWedge CDbl(txtDistance.Text), CDbl(txtLength.Text), CDbl(txtWidth.Text), AnLysType
        End If
        Select Case cmbPro.ListIndex
            Case 0
                staMode = scsMax
            Case 1
                staMode = scsMin
            Case 2
                staMode = scsAvg
            Case 3
                staMode = scsSum
            Case 4
                staMode = scsStdev
            Case 5
                staMode = scsVar
        End Select
        If ckNone.Value = 1 Then
            bIgnor = True
        Else
            bIgnor = False
        End If
        Set objDtRst = objStatisticOperator.NeighbourStatistics(objDtRst, staMode, objNeighborhoodParam, bIgnor, objDs, strTmp)
        If Not objDtRst Is Nothing Then
            frmMain.SuperWkspManager.Refresh
        Else
            MsgBox "领域分析失败", vbInformation, "信息提示"
        End If
        Set objDtRst = Nothing
        Set objDs = Nothing
        Set objGridAnalystEx = Nothing
        Set objStatisticOperator = Nothing
        Set objNeighborhoodParam = Nothing
        Unload Me
    Else
        txtDataset.Text = ""
        txtDataset.SetFocus
    End If
    
    Set objDtRst = Nothing
    Set objDs = Nothing
    Set objGridAnalystEx = Nothing
    Set objStatisticOperator = Nothing
    Set objNeighborhoodParam = Nothing
End Sub

Private Sub cmdSetCancel_Click()
    frameSet.Visible = False
End Sub

Private Sub cmdSetOk_Click()
    
    frameSet.Visible = False
End Sub

Private Sub Form_Activate()
    frmMain.bActiveFrm = True
    cmbDsList_Click
End Sub

Private Sub Form_Load()
    cmbPro.ListIndex = 0
End Sub

Private Sub optCircle_Click()
    If optCircle.Value = True Then
        txtDistance.Enabled = True
        txtDistance.BackColor = vbWhite
        txtLength.Enabled = False
        txtLength.BackColor = &H80000004
        txtWidth.Enabled = False
        txtWidth.BackColor = &H80000004
        Label1(4).Caption = "长度："
        Label1(3).Caption = "宽度："
    End If
End Sub

Private Sub optPie_Click()
    If optPie.Value = True Then
        txtDistance.Enabled = True
        txtDistance.BackColor = vbWhite
        txtLength.Enabled = True
        txtLength.BackColor = vbWhite
        txtWidth.Enabled = True
        txtWidth.BackColor = vbWhite
        Label1(4).Caption = "起始角："
        Label1(3).Caption = "终止角："
    End If
End Sub

Private Sub optRect_Click()
    If optRect.Value = True Then
        txtDistance.Enabled = False
        txtDistance.BackColor = &H80000004
        txtLength.Enabled = True
        txtLength.BackColor = vbWhite
        txtWidth.Enabled = True
        txtWidth.BackColor = vbWhite
        Label1(4).Caption = "长度："
        Label1(3).Caption = "宽度："
    End If
End Sub

Private Sub optRound_Click()
    If optRound.Value = True Then
        txtDistance.Enabled = False
        txtDistance.BackColor = &H80000004
        txtLength.Enabled = True
        txtLength.BackColor = vbWhite
        txtWidth.Enabled = True
        txtWidth.BackColor = vbWhite
        Label1(4).Caption = "内半径："
        Label1(3).Caption = "外半径："
    End If
End Sub


Private Sub txtDistance_Change()
    If (Trim(txtDistance.Text) = "") Then txtDistance.Text = "0"
End Sub

Private Sub txtDistance_KeyPress(KeyAscii As Integer)
    If (KeyAscii > Asc("9")) Or (KeyAscii < Asc("0")) Then
        If (KeyAscii <> vbKeyBack) And (KeyAscii <> Asc(".")) Then
            KeyAscii = 0
            Beep
        End If
    End If
End Sub

Private Sub txtLength_Change()
    If (Trim(txtLength.Text) = "") Then txtLength.Text = "0"
End Sub

Private Sub txtLength_KeyPress(KeyAscii As Integer)
    If (KeyAscii > Asc("9")) Or (KeyAscii < Asc("0")) Then
        If (KeyAscii <> vbKeyBack) And (KeyAscii <> Asc(".")) Then
            KeyAscii = 0
            Beep
        End If
    End If
End Sub

Private Sub txtWidth_Change()
    If (Trim(txtWidth.Text) = "") Then txtWidth.Text = "0"
End Sub

Private Sub txtWidth_KeyPress(KeyAscii As Integer)
    If (KeyAscii > Asc("9")) Or (KeyAscii < Asc("0")) Then
        If (KeyAscii <> vbKeyBack) And (KeyAscii <> Asc(".")) Then
            KeyAscii = 0
            Beep
        End If
    End If
End Sub