frmgridto.frm

网络分析与超图的VB开发程序的应用,对地理信息系统开发有益

VERSION 5.00
Begin VB.Form frmGridto 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "GRid转换"
   ClientHeight    =   4185
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4455
   Icon            =   "frmGridto.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4185
   ScaleWidth      =   4455
   ShowInTaskbar   =   0   'False
   Begin VB.OptionButton OptRegion 
      Caption         =   "Region"
      Height          =   255
      Left            =   3210
      TabIndex        =   14
      Top             =   105
      Width           =   975
   End
   Begin VB.OptionButton OptOrthoImage 
      Caption         =   "正射三维影像"
      Height          =   255
      Left            =   1305
      TabIndex        =   13
      Top             =   105
      Width           =   1695
   End
   Begin VB.OptionButton OptContour 
      Caption         =   "等值线"
      Height          =   255
      Left            =   270
      TabIndex        =   12
      Top             =   105
      Value           =   -1  'True
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "参数设置"
      Height          =   1650
      Left            =   2595
      TabIndex        =   10
      Top             =   1155
      Width           =   1755
      Begin VB.TextBox txtBase 
         Height          =   285
         Left            =   810
         TabIndex        =   23
         Text            =   "0"
         Top             =   900
         Width           =   855
      End
      Begin VB.TextBox TxtSmoothDegree 
         Height          =   285
         Left            =   810
         TabIndex        =   22
         Text            =   "3"
         Top             =   570
         Width           =   855
      End
      Begin VB.TextBox TxtContourDist 
         Height          =   285
         Left            =   810
         TabIndex        =   21
         Text            =   "50"
         Top             =   240
         Width           =   855
      End
      Begin VB.CheckBox chkProgress 
         Caption         =   "显示进程条"
         Height          =   255
         Left            =   495
         TabIndex        =   11
         Top             =   1335
         Width           =   1215
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "dBase"
         Height          =   195
         Left            =   135
         TabIndex        =   24
         Top             =   945
         Width           =   450
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "等值距"
         Height          =   195
         Left            =   135
         TabIndex        =   16
         Top             =   270
         Width           =   540
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "平滑度"
         Height          =   195
         Left            =   135
         TabIndex        =   15
         Top             =   607
         Width           =   540
      End
   End
   Begin VB.TextBox TxtDtNameTar 
      Height          =   315
      Left            =   1305
      TabIndex        =   5
      Top             =   3315
      Width           =   3060
   End
   Begin VB.ComboBox cmbDsNameTar 
      Height          =   315
      Left            =   1305
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   2925
      Width           =   3060
   End
   Begin VB.ComboBox cmbDtNameSrc 
      Height          =   315
      Left            =   1305
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   840
      Width           =   3060
   End
   Begin VB.ComboBox cmbDsNameSrc 
      Height          =   315
      Left            =   1305
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   405
      Width           =   3060
   End
   Begin VB.CommandButton btnCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   2790
      TabIndex        =   1
      Top             =   3720
      Width           =   1215
   End
   Begin VB.CommandButton btnOk 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   1290
      TabIndex        =   0
      Top             =   3720
      Width           =   1215
   End
   Begin VB.Label Label8 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "Grid高度"
      Height          =   195
      Index           =   3
      Left            =   225
      TabIndex        =   28
      Top             =   2550
      Width           =   645
   End
   Begin VB.Label Label8 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "Grid宽度"
      Height          =   195
      Index           =   2
      Left            =   225
      TabIndex        =   27
      Top             =   2130
      Width           =   645
   End
   Begin VB.Label Label8 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "最大高程"
      Height          =   195
      Index           =   1
      Left            =   225
      TabIndex        =   26
      Top             =   1725
      Width           =   720
   End
   Begin VB.Label Label8 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "最小高程"
      Height          =   195
      Index           =   0
      Left            =   225
      TabIndex        =   25
      Top             =   1305
      Width           =   720
   End
   Begin VB.Label LabelHeight 
      Caption         =   "Height"
      Height          =   255
      Left            =   1080
      TabIndex        =   20
      Top             =   2520
      Width           =   1425
   End
   Begin VB.Label LabelWidth 
      Caption         =   "Width"
      Height          =   255
      Left            =   1080
      TabIndex        =   19
      Top             =   2105
      Width           =   1425
   End
   Begin VB.Label LabelMax 
      Caption         =   "Max:"
      Height          =   255
      Left            =   1080
      TabIndex        =   18
      Top             =   1690
      Width           =   1425
   End
   Begin VB.Label LabelMin 
      Caption         =   "Min:"
      Height          =   255
      Left            =   1080
      TabIndex        =   17
      Top             =   1275
      Width           =   1425
   End
   Begin VB.Label Label5 
      Caption         =   "输出数据集"
      Height          =   255
      Left            =   225
      TabIndex        =   9
      Top             =   3345
      Width           =   975
   End
   Begin VB.Label Label4 
      Caption         =   "输出数据源"
      Height          =   255
      Left            =   225
      TabIndex        =   8
      Top             =   2955
      Width           =   975
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "输入数据集"
      Height          =   195
      Left            =   225
      TabIndex        =   7
      Top             =   900
      Width           =   900
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "输入数据源"
      Height          =   195
      Left            =   225
      TabIndex        =   6
      Top             =   480
      Width           =   900
   End
End
Attribute VB_Name = "frmGridto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim bProgress As Boolean

Private Sub btnCancel_Click() '取消操作
    Unload Me
End Sub
Private Sub chkProgress_Click()
    If ChkProgress.Value = vbChecked Then
        bProgress = True
    Else
        bProgress = False
    End If
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 = scdGrid Or objDT.Type = scdDEM 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 cmbDtNameSrc_Click()
    Dim objDS As soDataSource
    Dim objDtr As soDatasetRaster
    
    Set objDS = frmGridAnalyst.SuperWorkspace1.Datasources(CmbDsNameSrc.Text)
    If (objDS Is Nothing) Then Exit Sub
    Set objDtr = objDS.Datasets(CmbDtNameSrc.Text)
    If (objDtr Is Nothing) Then Exit Sub
    
    objDtr.Open
    LabelMin.Caption = objDtr.MinZ
    LabelMax.Caption = objDtr.MaxZ
    LabelWidth = objDtr.Bounds.Width
    LabelHeight = objDtr.Bounds.Height
    objDtr.Close
    
    Set objDS = Nothing
    Set objDtr = Nothing
End Sub

Private Sub Form_Load()
    Dim objDS As soDataSource
    bProgress = False
    '有效性
    If frmGridAnalyst.SuperWorkspace1.Datasources.Count = 0 Then
        MsgBox "请先打开有效数据源"
        'Unload frmGridto
        Exit Sub
    End If
    '有效性
    
    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 = Nothing
End Sub

Private Sub btnOk_Click() '开始操作
    Dim objDSSrc As soDataSource    '源数据源
    Dim objDSTar As soDataSource    '源数据集
    Dim objDtSrc As soDataset       '目标数据源
    Dim objDtTar As soDatasetVector
    
    Dim objGridAnalyst As New soGridAnalyst
    Dim bResult As Boolean
    
    If Trim(TxtContourDist) = "" Then
        MsgBox "请输入等值线间距！"
        TxtContourDist.SetFocus
        Exit Sub
    End If
    
    If Trim(txtBase) = "" Then
        MsgBox "请输入起始等高线值！"
        txtBase.SetFocus
        Exit Sub
    End If
    
    If Trim(TxtSmoothDegree) = "" Then
        MsgBox "请输入等高线光滑度！"
        TxtSmoothDegree.SetFocus
        Exit Sub
    End If
    
    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
    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 OptContour.Value = True Then
        '  bResult = objGridAnalyst.GridToIsoline(objDtSrc, objDSTar, TxtDtNameTar.Text, CDbl(Val(TxtContourDist.Text)), CInt(Val(TxtSmoothDegree.Text)), bProgress)
        bResult = objGridAnalyst.Contour(objDtSrc, objDSTar, TxtDtNameTar.Text, _
         CDbl(Val(TxtContourDist.Text)), CDbl(txtBase.Text), CInt(Val(TxtSmoothDegree.Text)), bProgress)
        
    ElseIf OptOrthoImage.Value = True Then
        
        Dim objColor As New soColors
        objColor.MakeStockGradientColorset 32, scrTerrain, scrBlackWhite
        bResult = objGridAnalyst.GridToOrthoImage(objDtSrc, objDSTar, TxtDtNameTar.Text, objColor, bProgress)
    
    ElseIf OptRegion.Value = True Then
    Set objDtTar = objDSTar.CreateDataset(Trim$(TxtDtNameTar.Text), scdRegion, scoDefault)
    
    If objDtTar Is Nothing Then
    MsgBox "数据集创建失败", vbInformation
    End If
    
    objDtSrc.Open
    bResult = objGridAnalyst.GridToRegion(objDtSrc, objDtTar, 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 objDtTar = Nothing
    Set objGridAnalyst = Nothing
    Unload Me
End Sub


Private Sub OptContour_Click() '等值线
    TxtContourDist.Enabled = True
    TxtSmoothDegree.Enabled = True
End Sub

Private Sub OptOrthoImage_Click() '正射三维影象
    TxtContourDist.Enabled = False
    TxtSmoothDegree.Enabled = False
End Sub

Private Sub OptRegion_Click() 'DEM转面
    TxtContourDist.Enabled = False
    TxtSmoothDegree.Enabled = False
End Sub

Private Sub TxtDtNameTar_Change()
    TxtDtNameTar.Text = Trim$(TxtDtNameTar.Text)
    If Len(TxtDtNameTar.Text) > 0 Then
          btnOk.Enabled = True
    Else
          btnOk.Enabled = False
    End If
End Sub