frmanalystenvionment.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

VERSION 5.00
Begin VB.Form frmAnalystEnvionment 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "栅格分析环境设置"
   ClientHeight    =   4395
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6735
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4395
   ScaleWidth      =   6735
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame Frame2 
      Height          =   915
      Left            =   3345
      TabIndex        =   20
      Top             =   1275
      Width           =   3345
      Begin VB.CheckBox ckShowProgress 
         Alignment       =   1  'Right Justify
         Caption         =   "是否显示分析进程条："
         Height          =   285
         Left            =   45
         TabIndex        =   23
         Top             =   540
         Width           =   2175
      End
      Begin VB.ComboBox cmbDsList 
         Height          =   315
         Left            =   2010
         Style           =   2  'Dropdown List
         TabIndex        =   22
         Top             =   150
         Width           =   1170
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "存储结果的数据源："
         Height          =   195
         Index           =   8
         Left            =   240
         TabIndex        =   21
         Top             =   210
         Width           =   1620
      End
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   435
      Left            =   3390
      TabIndex        =   19
      Top             =   3855
      Width           =   945
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   435
      Left            =   2190
      TabIndex        =   18
      Top             =   3855
      Width           =   945
   End
   Begin VB.Frame Frame4 
      Caption         =   "结果数据集分辨率设置"
      Height          =   1545
      Left            =   3360
      TabIndex        =   4
      Top             =   2190
      Width           =   3330
      Begin VB.TextBox txtCellHeight 
         Height          =   315
         Left            =   1260
         TabIndex        =   13
         Top             =   1080
         Width           =   1905
      End
      Begin VB.TextBox txtCellWidth 
         Height          =   315
         Left            =   1260
         TabIndex        =   6
         Top             =   675
         Width           =   1890
      End
      Begin VB.ComboBox cmbCell 
         Height          =   315
         Left            =   1260
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   285
         Width           =   1905
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "图元高度："
         Height          =   195
         Index           =   5
         Left            =   345
         TabIndex        =   12
         Top             =   1140
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "图元宽度："
         Height          =   195
         Index           =   7
         Left            =   345
         TabIndex        =   8
         Top             =   720
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "参考设置："
         Height          =   195
         Index           =   6
         Left            =   345
         TabIndex        =   7
         Top             =   330
         Width           =   900
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "结果数据集范围设置"
      Height          =   2460
      Left            =   30
      TabIndex        =   0
      Top             =   1275
      Width           =   3255
      Begin VB.TextBox txtYTop 
         Height          =   300
         Left            =   1260
         TabIndex        =   17
         Top             =   2010
         Width           =   1875
      End
      Begin VB.TextBox txtXRight 
         Height          =   300
         Left            =   1260
         TabIndex        =   16
         Top             =   1575
         Width           =   1875
      End
      Begin VB.TextBox txtYBottom 
         Height          =   300
         Left            =   1260
         TabIndex        =   15
         Top             =   1140
         Width           =   1875
      End
      Begin VB.TextBox txtXleft 
         Height          =   300
         Left            =   1260
         TabIndex        =   14
         Top             =   705
         Width           =   1875
      End
      Begin VB.ComboBox cmbBounds 
         Height          =   315
         Left            =   1260
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   255
         Width           =   1905
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "最大Y值："
         Height          =   195
         Index           =   4
         Left            =   420
         TabIndex        =   11
         Top             =   2055
         Width           =   825
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "最大X值："
         Height          =   195
         Index           =   3
         Left            =   420
         TabIndex        =   10
         Top             =   1623
         Width           =   825
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "最小Y值："
         Height          =   195
         Index           =   2
         Left            =   420
         TabIndex        =   9
         Top             =   1192
         Width           =   825
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "最小X值："
         Height          =   195
         Index           =   1
         Left            =   420
         TabIndex        =   3
         Top             =   761
         Width           =   825
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "参考设置："
         Height          =   195
         Index           =   0
         Left            =   345
         TabIndex        =   2
         Top             =   330
         Width           =   900
      End
   End
   Begin VB.Image Image1 
      Appearance      =   0  'Flat
      BorderStyle     =   1  'Fixed Single
      Height          =   1185
      Left            =   15
      Picture         =   "frmAnalystEnvionment.frx":0000
      Stretch         =   -1  'True
      Top             =   0
      Width           =   6720
   End
End
Attribute VB_Name = "frmAnalystEnvionment"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim iCelWth As Integer
Dim iCelLth As Integer
Dim dLeft As Double
Dim dRight As Double
Dim dTop As Double
Dim dBottom As Double

Private Sub cmbBounds_Click()
    If cmbBounds.Text = "" Then Exit Sub
    If frmMain.bActiveFrm Then
        If cmbBounds.ListIndex > 1 Then
            txtXleft.Enabled = True
            txtXleft.BackColor = vbWhite
            txtYBottom.Enabled = True
            txtYBottom.BackColor = vbWhite
            txtXRight.Enabled = True
            txtXRight.BackColor = vbWhite
            txtYTop.Enabled = True
            txtYTop.BackColor = vbWhite
            GetBoundsCellsValue 1, cmbBounds.Text
        Else
            txtXleft.Enabled = False
            txtXleft.BackColor = &H80000004
            txtYBottom.Enabled = False
            txtYBottom.BackColor = &H80000004
            txtXRight.Enabled = False
            txtXRight.BackColor = &H80000004
            txtYTop.Enabled = False
            txtYTop.BackColor = &H80000004
        End If
    End If
End Sub

Private Sub cmbCell_Click()
    If cmbCell.Text = "" Then Exit Sub
    If frmMain.bActiveFrm Then
        If cmbCell.ListIndex > 1 Then
            txtCellHeight.Enabled = True
            txtCellHeight.BackColor = vbWhite
            txtCellWidth.Enabled = True
            txtCellWidth.BackColor = vbWhite
            GetBoundsCellsValue 2, cmbCell.Text
        Else
            txtCellHeight.Enabled = False
            txtCellHeight.BackColor = &H80000004
            txtCellWidth.Enabled = False
            txtCellWidth.BackColor = &H80000004
        End If
    End If
End Sub

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

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOk_Click()
    Dim objRect As New soRect
    
    If cmbBounds.ListIndex > 1 Then
        objRect.Left = CDbl(txtXleft.Text)
        objRect.Right = CDbl(txtXRight.Text)
        objRect.Top = CDbl(txtYTop.Text)
        objRect.Bottom = CDbl(txtYBottom.Text)
        frmMain.objAnalystEnvmnt.SetBound sceRasterEnvValue, objRect
    Else
        frmMain.objAnalystEnvmnt.SetBound cmbBounds.ListIndex + 1
    End If
    If cmbCell.ListIndex > 1 Then
        frmMain.objAnalystEnvmnt.SetCellSize sceRasterEnvValue, CInt(txtCellHeight.Text)
    Else
        frmMain.objAnalystEnvmnt.SetCellSize cmbCell.ListIndex + 1
    End If
    frmMain.objAnalystEnvmnt.OutputDatasourceAlias = cmbDsList.Text
    frmMain.objAnalystEnvmnt.ShowProgress = IIf(ckShowProgress.Value = 1, True, False)
    
    Set objRect = Nothing
    Unload Me
End Sub

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

Private Sub InitBoundsCells()
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim strDs As String
    Dim strDt As String
    Dim i As Integer
    Dim iCnt As Integer
    
    strDs = cmbDsList.Text
    Set objDs = frmMain.SuperWorkspace.Datasources(strDs)
    cmbBounds.Clear
    cmbBounds.AddItem "分析数据的范围交集"
    cmbBounds.AddItem "分析数据的范围并集"
    cmbCell.Clear
    cmbCell.AddItem "分析数据的最小分辨率"
    cmbCell.AddItem "分析数据的最大分辨率"
    iCnt = objDs.Datasets.Count
    If iCnt > 0 Then
        For i = 1 To iCnt
            Set objDt = objDs.Datasets(i)
            If objDt.Type = scdDEM Or objDt.Type = scdGrid Then
                strDt = objDt.Name
                cmbBounds.AddItem strDt
                cmbCell.AddItem strDt
            End If
        Next i
    End If
    cmbBounds.ListIndex = 0
    cmbCell.ListIndex = 0
    cmbBounds.Refresh
    cmbCell.Refresh
    Set objDt = Nothing
    Set objDs = Nothing
End Sub


Private Sub GetBoundsCellsValue(iBndCel As Integer, strName As String)
    Dim objDtRst As soDatasetRaster
    Dim objDs As soDataSource
    Dim objRect As soRect
    Dim dValue As Double
    Dim iValue As Integer
    Dim strDs As String
    
    strDs = cmbDsList.Text
    Set objDs = frmMain.SuperWorkspace.Datasources(strDs)
    Set objDtRst = objDs.Datasets(strName)
    Set objRect = objDtRst.Bounds
    If iBndCel = 1 Then
        dLeft = objRect.Left
        dBottom = objRect.Bottom
        dRight = objRect.Right
        dTop = objRect.Top
        txtXleft.Text = objRect.Left
        txtYBottom.Text = objRect.Bottom
        txtXRight.Text = objRect.Right
        txtYTop.Text = objRect.Top
    ElseIf iBndCel = 2 Then
        iCelLth = objDtRst.ResolutionY
        iCelWth = objDtRst.ResolutionX
        txtCellHeight.Text = iCelLth
        txtCellWidth.Text = iCelWth
    End If
    Set objRect = Nothing
    Set objDtRst = Nothing
    Set objDs = Nothing
End Sub

Private Sub txtCellHeight_Change()
    If Trim(txtCellHeight.Text) = "" Then txtCellHeight.Text = iCelLth
End Sub

Private Sub txtCellHeight_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 txtCellWidth_Change()
    If Trim(txtCellWidth.Text) = "" Then txtCellWidth.Text = iCelWth
End Sub

Private Sub txtCellWidth_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 txtXleft_Change()
    If Trim(txtXleft.Text) = "" Then txtXleft.Text = dLeft
End Sub

Private Sub txtXleft_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 txtXRight_Change()
    If Trim(txtXRight.Text) = "" Then txtXRight.Text = dRight
End Sub

Private Sub txtXRight_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 txtYBottom_Change()
    If Trim(txtYBottom.Text) = "" Then txtYBottom.Text = dBottom
End Sub

Private Sub txtYBottom_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 txtYTop_Change()
    If Trim(txtYTop.Text) = "" Then txtYTop.Text = dTop
End Sub

Private Sub txtYTop_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