📄 frmsurfaceslope.frm
字号:
VERSION 5.00
Begin VB.Form frmSurfaceSlope
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 = 4410
TabIndex = 16
Top = 3705
Width = 945
End
Begin VB.CommandButton cmdOk
Caption = "确定"
Height = 435
Left = 3300
TabIndex = 15
Top = 3705
Width = 945
End
Begin VB.Frame Frame4
Caption = "结果数据集保存"
Height = 1140
Left = 1950
TabIndex = 9
Top = 1260
Width = 3405
Begin VB.TextBox txtDataset
Height = 315
Left = 1095
TabIndex = 14
Text = "Raster"
Top = 675
Width = 2070
End
Begin VB.ComboBox cmbDsListResult
Height = 315
Left = 1095
Style = 2 'Dropdown List
TabIndex = 10
Top = 285
Width = 2070
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "数据源:"
Height = 195
Index = 6
Left = 340
TabIndex = 12
Top = 330
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "数据集:"
Height = 195
Index = 7
Left = 340
TabIndex = 11
Top = 705
Width = 720
End
End
Begin VB.Frame Frame3
Caption = "坡度分析类型"
Height = 1065
Left = 1950
TabIndex = 5
Top = 2460
Width = 3405
Begin VB.ComboBox cmbList
Height = 315
ItemData = "frmSurfaceSlope.frx":0000
Left = 1620
List = "frmSurfaceSlope.frx":000D
Style = 2 'Dropdown List
TabIndex = 13
Top = 240
Width = 1545
End
Begin VB.TextBox txtZScale
Height = 285
Left = 1635
TabIndex = 6
Text = "1"
Top = 615
Width = 1515
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "坡度分析类型:"
Height = 195
Index = 4
Left = 340
TabIndex = 8
Top = 300
Width = 1260
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "高程比例因子:"
Height = 195
Index = 5
Left = 345
TabIndex = 7
Top = 645
Width = 1260
End
End
Begin VB.Frame Frame1
Caption = "参加分析的数据"
Height = 1170
Left = 1950
TabIndex = 0
Top = 45
Width = 3390
Begin VB.ComboBox cmbDsList
Height = 315
Left = 1095
Style = 2 'Dropdown List
TabIndex = 2
Top = 255
Width = 2100
End
Begin VB.ComboBox cmbDtList
Height = 315
Left = 1095
Style = 2 'Dropdown List
TabIndex = 1
Top = 705
Width = 2100
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "数据源:"
Height = 195
Index = 0
Left = 340
TabIndex = 4
Top = 330
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "数据集:"
Height = 195
Index = 1
Left = 340
TabIndex = 3
Top = 705
Width = 720
End
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 4320
Left = 45
Picture = "frmSurfaceSlope.frx":0023
Stretch = -1 'True
Top = 0
Width = 1875
End
End
Attribute VB_Name = "frmSurfaceSlope"
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 cmdOk_Click()
Dim objDs As soDataSource
Dim objDtRst As soDatasetRaster
Dim objSurfaceAnalyst As soSurfaceAnalyst
Dim objSurfaceOperator As soSurfaceOperator
Dim myseSlopeType As seSlopeType
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
myseSlopeType = cmbList.ListIndex + 1
Set objDtRst = objSurfaceOperator.Slope(objDtRst, myseSlopeType, CDbl(txtZScale.Text), objDs, strTmp)
If Not objDtRst Is Nothing Then
frmMain.SuperWkspManager.Refresh
Else
MsgBox "生成坡度图失败", vbInformation, "信息提示"
End If
Set objDtRst = Nothing
Set objDs = Nothing
Set objSurfaceAnalyst = Nothing
Set objSurfaceOperator = Nothing
Unload Me
Else
txtDataset.Text = ""
txtDataset.SetFocus
End If
Set objDtRst = Nothing
Set objDs = Nothing
Set objSurfaceAnalyst = Nothing
Set objSurfaceOperator = Nothing
End Sub
Private Sub Form_Activate()
frmMain.bActiveFrm = True
cmbDsList_Click
End Sub
Private Sub Form_Load()
cmbList.ListIndex = 0
End Sub
Private Sub txtZScale_Change()
If Trim(txtZScale.Text) = "" Then txtZScale.Text = 1
End Sub
Private Sub txtZScale_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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -