📄 frmaspslp.frm
字号:
VERSION 5.00
Begin VB.Form frmGridAspSlp
BorderStyle = 3 'Fixed Dialog
Caption = "坡度坡向"
ClientHeight = 3960
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 4140
Icon = "frmAspSlp.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3960
ScaleWidth = 4140
ShowInTaskbar = 0 'False
Begin VB.TextBox TxtDtNameTar
Height = 315
Left = 1305
TabIndex = 11
Top = 3075
Width = 2685
End
Begin VB.Frame Frame1
Caption = "参数设置"
Height = 1035
Left = 225
TabIndex = 7
Top = 1560
Width = 3795
Begin VB.CheckBox chkProgress
Caption = "显示进度条"
Height = 330
Left = 2430
TabIndex = 18
Top = 570
Width = 1245
End
Begin VB.TextBox TxtZFactor
Height = 285
Left = 1590
TabIndex = 12
Text = "1"
Top = 585
Width = 555
End
Begin VB.OptionButton OptPercent
Caption = "百分比"
Height = 255
Left = 2775
TabIndex = 10
Top = 285
Width = 975
End
Begin VB.OptionButton OptRadian
Caption = "弧度"
Height = 255
Left = 1590
TabIndex = 9
Top = 285
Width = 975
End
Begin VB.OptionButton OptAngle
Caption = "角度"
Height = 255
Left = 420
TabIndex = 8
Top = 285
Value = -1 'True
Width = 975
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "高程缩放因子"
Height = 195
Left = 375
TabIndex = 13
Top = 615
Width = 1080
End
End
Begin VB.ComboBox cmbDsNameTar
Height = 315
Left = 1305
Style = 2 'Dropdown List
TabIndex = 6
Top = 2685
Width = 2685
End
Begin VB.ComboBox cmbDtNameSrc
Height = 315
Left = 1305
Style = 2 'Dropdown List
TabIndex = 5
Top = 1155
Width = 2685
End
Begin VB.ComboBox cmbDsNameSrc
Height = 315
Left = 1305
Style = 2 'Dropdown List
TabIndex = 4
Top = 690
Width = 2685
End
Begin VB.OptionButton OptAspect
Caption = "坡向"
Height = 255
Left = 2940
TabIndex = 3
Top = 150
Width = 975
End
Begin VB.OptionButton OptSlope
Caption = "坡度"
Height = 255
Left = 1980
TabIndex = 2
Top = 150
Value = -1 'True
Width = 825
End
Begin VB.CommandButton btnCancel
Cancel = -1 'True
Caption = "取消"
Height = 375
Left = 2625
TabIndex = 1
Top = 3495
Width = 1215
End
Begin VB.CommandButton btnOk
Caption = "确定"
Default = -1 'True
Height = 375
Left = 1320
TabIndex = 0
Top = 3495
Width = 1215
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "生成结果类型"
Height = 195
Left = 285
TabIndex = 19
Top = 150
Width = 1080
End
Begin VB.Line Line1
X1 = 165
X2 = 3885
Y1 = 480
Y2 = 480
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "输出数据集"
Height = 195
Left = 285
TabIndex = 17
Top = 3135
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "输出数据源"
Height = 195
Left = 285
TabIndex = 16
Top = 2745
Width = 900
End
Begin VB.Label Label3
Caption = "输入数据集"
Height = 255
Left = 285
TabIndex = 15
Top = 1200
Width = 975
End
Begin VB.Label Label2
Caption = "输入数据源"
Height = 255
Left = 285
TabIndex = 14
Top = 720
Width = 975
End
End
Attribute VB_Name = "frmGridAspSlp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim iSlopeType As Integer '坡度类型
Dim bProgress As Boolean '是否显示进度条
Private Sub btnCancel_Click() '取消操作
Unload Me
End Sub
Private Sub chkProgress_Click() '进度条
bProgress = True
End Sub
Private Sub cmbDsNameSrc_Click() '选择原数据源
Dim objDS As soDataSource
Dim objDT As soDataset
Dim strName As String
strName = CmbDsNameSrc.Text
Set objDS = frmGridAnalyst.SuperWorkspace1.Datasources.Item(strName)
CmbDtNameSrc.Clear
For Each objDT In objDS.Datasets
If objDT.Type = scdDEM Or objDT.Type = scdGrid Then
CmbDtNameSrc.AddItem (objDT.Name)
End If
Next
If CmbDtNameSrc.ListCount > 0 Then CmbDtNameSrc.ListIndex = 0
Set objDS = Nothing
Set objDT = Nothing
End Sub
Private Sub Form_Load() '自动加载
Dim objDS As soDataSource
' Dim objDT As soDataset
Dim strName As String
iSlopeType = sctDegree
bProgress = False
For Each objDS In frmGridAnalyst.SuperWorkspace1.Datasources
CmbDsNameSrc.AddItem objDS.Alias
CmbDsNameTar.AddItem objDS.Alias
Next
If CmbDsNameSrc.ListCount > 0 Then CmbDsNameSrc.ListIndex = 0
If CmbDsNameTar.ListCount > 0 Then CmbDsNameTar.ListIndex = 0
' Set objDS = frmGridAnalyst.SuperWorkspace1.Datasources.Item(1)
' If objDS Is Nothing Then
' MsgBox "打开数据源失败！", vbInformation
' btnOk.Enabled = False
' Exit Sub
' End If
'
' For Each objDT In objDS.Datasets
' If objDT.Type = scdDEM Or objDT.Type = scdGrid Then
' cmbDtNameSrc.AddItem (objDT.Name)
' End If
' Next
' cmbDtNameSrc.Text = objDS.Datasets.Item(1).Name
Set objDS = Nothing
' Set objDT = Nothing
End Sub
Private Sub btnOk_Click() '开始操作
Dim objDSSrc As soDataSource '源数据源
Dim objDSTar As soDataSource '目标数据源
Dim objDtSrc As soDataset '源数据集
Dim objGridAnalyst As New soGridAnalyst
Dim bResult As Boolean
Set objDSSrc = frmGridAnalyst.SuperWorkspace1.Datasources.Item(CmbDsNameSrc.Text)
If (objDSSrc Is Nothing) Then
MsgBox "数据源" & CmbDsNameSrc.Text & "有错误！", vbInformation
Exit Sub
End If
Set objDtSrc = objDSSrc.Datasets.Item(CmbDtNameSrc.Text)
If objDtSrc Is Nothing Then
MsgBox "数据集" & CmbDtNameSrc.Text & "有错误！", vbInformation
Exit Sub
End If
'处理结果数据源、数据集
Set objDSTar = frmGridAnalyst.SuperWorkspace1.Datasources.Item(CmbDsNameTar.Text)
If objDSTar Is Nothing Then
MsgBox "数据源" & CmbDsNameTar.Text & "有错误！", vbInformation
Exit Sub
End If
If objDSTar.IsAvailableDatasetName(Trim$(TxtDtNameTar.Text)) = False Then
Set objDSTar = Nothing
MsgBox "数据集名称" & TxtDtNameTar.Text & "非法！", vbInformation
TxtDtNameTar.SetFocus
Exit Sub
End If
If OptSlope.Value = True Then
bResult = objGridAnalyst.Slope(objDtSrc, objDSTar, TxtDtNameTar.Text, iSlopeType, CDbl(Val(TxtZFactor.Text)), bProgress)
ElseIf OptAspect.Value = True Then
bResult = objGridAnalyst.Aspect(objDtSrc, objDSTar, TxtDtNameTar.Text, bProgress)
End If
If bResult = True Then
frmGridAnalyst.SuperWkspManager1.Refresh
Else
MsgBox "Grid分析失败!", vbInformation
End If
Set objDSSrc = Nothing
Set objDSTar = Nothing
Set objDtSrc = Nothing
Set objGridAnalyst = Nothing
Unload Me
End Sub
Private Sub OptAngle_Click() '角度
iSlopeType = sctDegree
End Sub
Private Sub OptAspect_Click() '坡向
OptAngle.Enabled = False
OptRadian.Enabled = False
OptPercent.Enabled = False
TxtZFactor.Enabled = False
End Sub
Private Sub OptPercent_Click() '百分比
iSlopeType = sctPercent
End Sub
Private Sub OptRadian_Click() '弧度
iSlopeType = sctRadian
End Sub
Private Sub OptSlope_Click() '坡度
OptAngle.Enabled = True
OptRadian.Enabled = True
OptPercent.Enabled = True
TxtZFactor.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -