frmhdroflowlength.frm

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

VERSION 5.00
Begin VB.Form frmHdroFlowLength 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "坡长分析"
   ClientHeight    =   4290
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5370
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4290
   ScaleWidth      =   5370
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   435
      Left            =   4380
      TabIndex        =   17
      Top             =   3735
      Width           =   945
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   435
      Left            =   3270
      TabIndex        =   16
      Top             =   3735
      Width           =   945
   End
   Begin VB.CheckBox ckUp 
      Caption         =   "溯流而上"
      Height          =   210
      Left            =   1980
      TabIndex        =   15
      Top             =   3765
      Width           =   1050
   End
   Begin VB.Frame Frame2 
      Caption         =   "参加权重的数据"
      Height          =   1170
      Left            =   1965
      TabIndex        =   10
      Top             =   1200
      Width           =   3390
      Begin VB.ComboBox cmbDsListTog 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   12
         Top             =   255
         Width           =   2100
      End
      Begin VB.ComboBox cmbDtListTog 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   11
         Top             =   705
         Width           =   2100
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据源："
         Height          =   195
         Index           =   3
         Left            =   340
         TabIndex        =   14
         Top             =   330
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据集："
         Height          =   195
         Index           =   2
         Left            =   340
         TabIndex        =   13
         Top             =   705
         Width           =   720
      End
   End
   Begin VB.Frame Frame4 
      Caption         =   "结果数据集保存"
      Height          =   1140
      Left            =   1965
      TabIndex        =   5
      Top             =   2400
      Width           =   3390
      Begin VB.TextBox txtDataset 
         Height          =   315
         Left            =   1095
         TabIndex        =   7
         Text            =   "Raster"
         Top             =   660
         Width           =   2070
      End
      Begin VB.ComboBox cmbDsListResult 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   285
         Width           =   2070
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据集："
         Height          =   195
         Index           =   7
         Left            =   340
         TabIndex        =   9
         Top             =   705
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据源："
         Height          =   195
         Index           =   6
         Left            =   340
         TabIndex        =   8
         Top             =   330
         Width           =   720
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "参加分析的数据"
      Height          =   1170
      Left            =   1965
      TabIndex        =   0
      Top             =   15
      Width           =   3390
      Begin VB.ComboBox cmbDtList 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   705
         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            =   340
         TabIndex        =   4
         Top             =   705
         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.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   4290
      Left            =   60
      Picture         =   "frmHdroFlowLength.frx":0000
      Stretch         =   -1  'True
      Top             =   0
      Width           =   1860
   End
End
Attribute VB_Name = "frmHdroFlowLength"
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 cmbDsListTog_Click()
    If cmbDsListTog.Text = "" Then Exit Sub
    If frmMain.bActiveFrm Then
        ChangeDs cmbDsListTog.Text, cmbDtListTog
        cmbDtListTog.AddItem ""
    End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOk_Click()
    Dim objDs As soDataSource
    Dim objDtRst As soDatasetRaster
    Dim objDtWDt As soDatasetRaster
    Dim objSurfaceAnalyst As soSurfaceAnalyst
    Dim objHdroOperator As soHydrologyOperator
    Dim strTmp As String
    Dim bDownStream As Boolean
    Dim bWeight As Boolean
    
    Set objDs = frmMain.SuperWorkspace.Datasources(cmbDsList.Text)
    Set objDtRst = objDs.Datasets(cmbDtList.Text)
    If cmbDtListTog.Text = "" Then
        bWeight = False
    Else
        bWeight = True
        Set objDs = frmMain.SuperWorkspace.Datasources(cmbDsListTog.Text)
        Set objDtWDt = objDs.Datasets(cmbDtListTog.Text)
    End If
    Set objDs = frmMain.SuperWorkspace.Datasources(cmbDsListResult.Text)
    strTmp = DataSetName(objDs, txtDataset.Text)
    If strTmp <> "" Then
        Set objSurfaceAnalyst = frmMain.SuperAnalyst.SurfaceAnalyst
        Set objHdroOperator = objSurfaceAnalyst.Hydrology
        bDownStream = IIf(ckUp.Value = 1, False, True)
        If bWeight Then
            Set objDtRst = objHdroOperator.FlowLength(objDtRst, bDownStream, objDtWDt, objDs, strTmp)
        Else
            Set objDtRst = objHdroOperator.FlowLength(objDtRst, bDownStream, , objDs, strTmp)
        End If
        If Not objDtRst Is Nothing Then
            frmMain.SuperWkspManager.Refresh
        Else
            MsgBox "坡长分析失败", vbInformation, "信息提示"
        End If
        Set objDtWDt = Nothing
        Set objDtRst = Nothing
        Set objDs = Nothing
        Set objSurfaceAnalyst = Nothing
        Set objHdroOperator = Nothing
        Unload Me
    Else
        txtDataset.Text = ""
        txtDataset.SetFocus
    End If
    
    Set objDtWDt = Nothing
    Set objDtRst = Nothing
    Set objDs = Nothing
    Set objSurfaceAnalyst = Nothing
    Set objHdroOperator = Nothing
End Sub

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