frmsurfaceisoline.frm

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

VERSION 5.00
Begin VB.Form frmSurfaceIsoLine 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "提取等值线"
   ClientHeight    =   4320
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5370
   ControlBox      =   0   'False
   Icon            =   "frmSurfaceIsoLine.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4320
   ScaleWidth      =   5370
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   435
      Left            =   4305
      TabIndex        =   21
      Top             =   3735
      Width           =   945
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   435
      Left            =   3195
      TabIndex        =   20
      Top             =   3735
      Width           =   945
   End
   Begin VB.Frame Frame4 
      Caption         =   "结果数据集保存"
      Height          =   1140
      Left            =   1905
      TabIndex        =   11
      Top             =   2445
      Width           =   3345
      Begin VB.TextBox txtDataset 
         Height          =   315
         Left            =   1095
         TabIndex        =   19
         Text            =   "Raster"
         Top             =   660
         Width           =   2070
      End
      Begin VB.ComboBox cmbDsListResult 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   14
         Top             =   285
         Width           =   2070
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据集："
         Height          =   195
         Index           =   7
         Left            =   340
         TabIndex        =   13
         Top             =   705
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据源："
         Height          =   195
         Index           =   6
         Left            =   340
         TabIndex        =   12
         Top             =   330
         Width           =   720
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "等值线参数设置"
      Height          =   630
      Left            =   1890
      TabIndex        =   8
      Top             =   1800
      Width           =   3405
      Begin VB.TextBox txtSmooth 
         Height          =   285
         Left            =   2415
         TabIndex        =   18
         Text            =   "2"
         Top             =   255
         Width           =   600
      End
      Begin VB.TextBox txtGrads 
         Height          =   285
         Left            =   1035
         TabIndex        =   17
         Text            =   "50"
         Top             =   255
         Width           =   600
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "光滑度："
         Height          =   195
         Index           =   5
         Left            =   1725
         TabIndex        =   10
         Top             =   300
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "等高距："
         Height          =   195
         Index           =   4
         Left            =   345
         TabIndex        =   9
         Top             =   300
         Width           =   720
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "数据集高程信息"
      Height          =   615
      Left            =   1905
      TabIndex        =   5
      Top             =   1185
      Width           =   3375
      Begin VB.Label lblZMax 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "0"
         Height          =   285
         Left            =   2205
         TabIndex        =   16
         Top             =   225
         Width           =   1035
      End
      Begin VB.Label lblZMin 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "0"
         Height          =   285
         Left            =   840
         TabIndex        =   15
         Top             =   225
         Width           =   795
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "最大："
         Height          =   195
         Index           =   3
         Left            =   1710
         TabIndex        =   7
         Top             =   270
         Width           =   540
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "最小："
         Height          =   195
         Index           =   2
         Left            =   340
         TabIndex        =   6
         Top             =   270
         Width           =   540
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "参加分析的数据"
      Height          =   1170
      Left            =   1905
      TabIndex        =   0
      Top             =   0
      Width           =   3390
      Begin VB.ComboBox cmbDtList 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   705
         Width           =   2100
      End
      Begin VB.ComboBox cmbDsList 
         Height          =   315
         Left            =   1095
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   255
         Width           =   2100
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据集："
         Height          =   195
         Index           =   1
         Left            =   340
         TabIndex        =   2
         Top             =   705
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据源："
         Height          =   195
         Index           =   0
         Left            =   340
         TabIndex        =   1
         Top             =   330
         Width           =   720
      End
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   4335
      Left            =   0
      Picture         =   "frmSurfaceIsoLine.frx":000C
      Stretch         =   -1  'True
      Top             =   0
      Width           =   1875
   End
End
Attribute VB_Name = "frmSurfaceIsoLine"
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 cmbDtList_Click()
    If cmbDsList.Text = "" Then Exit Sub
    If frmMain.bActiveFrm Then
        GetZValue cmbDsList.Text, cmbDtList.Text
    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 objDtv As soDatasetVector
    Dim objSurfaceAnalyst As soSurfaceAnalyst
    Dim objSurfaceOperator As soSurfaceOperator
    Dim strTmp As String
    
    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 objSurfaceAnalyst = frmMain.SuperAnalyst.SurfaceAnalyst
        Set objSurfaceOperator = objSurfaceAnalyst.Surface
        Set objDtv = objSurfaceOperator.Isoline(objDtRst, CDbl(txtGrads.Text), , CInt(txtSmooth.Text), objDs, strTmp)
        If Not objDtv Is Nothing Then
            frmMain.SuperWkspManager.Refresh
        Else
            MsgBox "生成等值线数据失败", vbInformation, "信息提示"
        End If
        Set objDtRst = Nothing
        Set objDs = Nothing
        Set objDtv = Nothing
        Set objSurfaceAnalyst = Nothing
        Set objSurfaceOperator = Nothing
        Unload Me
    Else
        txtDataset.Text = ""
        txtDataset.SetFocus
    End If
    
    Set objDtRst = Nothing
    Set objDs = Nothing
    Set objDtv = Nothing
    Set objSurfaceAnalyst = Nothing
    Set objSurfaceOperator = Nothing
End Sub

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

Private Sub GetZValue(strDs As String, strDt As String)
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim objDR As soDatasetRaster
    Set objDs = frmMain.SuperWorkspace.Datasources(strDs)
    Set objDt = objDs.Datasets(strDt)
    Set objDR = objDt
    lblZMax.Caption = objDR.MaxZ
    lblZMax.Refresh
    lblZMin.Caption = objDR.MinZ
    lblZMin.Refresh
    Set objDt = Nothing
    Set objDs = Nothing
End Sub

Private Sub txtGrads_Change()
    If Trim(txtGrads.Text) = "" Then txtGrads.Text = "5"
End Sub

Private Sub txtGrads_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 txtSmooth_Change()
    If Trim(txtSmooth.Text) = "" Then txtSmooth.Text = "2"
End Sub

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