frmmain.frm

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

VERSION 5.00
Object = "{02BEE3A6-4264-45B0-93C8-76FBBA329150}#5.1#0"; "SuperLegend.ocx"
Object = "{A61255F7-0A20-431C-86CE-78C14314BE9E}#5.1#0"; "SuperWkspManager.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.1#0"; "SuperMap.ocx"
Object = "{19C64102-BC0F-4C56-89B2-C4865179A52C}#5.1#0"; "SuperAnalyst.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "栅格分析扩展演示"
   ClientHeight    =   6660
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   10500
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6660
   ScaleWidth      =   10500
   StartUpPosition =   2  'CenterScreen
   Begin SuperLegendLib.SuperLegend SuperLegend 
      Height          =   2190
      Left            =   45
      TabIndex        =   3
      Top             =   4425
      Width           =   2520
      _Version        =   327681
      _ExtentX        =   4445
      _ExtentY        =   3863
      _StockProps     =   132
      Appearance      =   1
   End
   Begin MSComDlg.CommonDialog cmDlg 
      Left            =   1260
      Top             =   4140
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin SuperAnalystLib.SuperAnalyst SuperAnalyst 
      Left            =   1935
      Top             =   4110
      _Version        =   327681
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.Frame Frame1 
      Height          =   6660
      Left            =   2595
      TabIndex        =   1
      Top             =   0
      Width           =   7875
      Begin SuperMapLib.SuperMap SuperMap 
         Height          =   6495
         Left            =   15
         TabIndex        =   2
         Top             =   120
         Width           =   7800
         _Version        =   327681
         _ExtentX        =   13758
         _ExtentY        =   11456
         _StockProps     =   160
         Appearance      =   1
      End
   End
   Begin SuperWkspManagerLib.SuperWkspManager SuperWkspManager 
      Height          =   4380
      Left            =   0
      TabIndex        =   0
      Top             =   30
      Width           =   2565
      _Version        =   327681
      _ExtentX        =   4524
      _ExtentY        =   7726
      _StockProps     =   0
      DataTab         =   1
      MapTab          =   1
      LayoutTab       =   1
      SenceTab        =   1
      ResourceTab     =   1
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace 
      Left            =   4815
      Top             =   4575
      _Version        =   327681
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.Menu mnuOpen 
      Caption         =   "打开"
      Begin VB.Menu mnuFileOpenWks 
         Caption         =   "打开工作空间"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileOpenDs 
         Caption         =   "打开数据源"
      End
      Begin VB.Menu mnuFileSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnuMap 
      Caption         =   "地图操作"
      Begin VB.Menu mnuMapSel 
         Caption         =   "选择"
      End
      Begin VB.Menu mnuMapZoomIn 
         Caption         =   "放大"
      End
      Begin VB.Menu mnuMapZoomOut 
         Caption         =   "缩小"
      End
      Begin VB.Menu mnuMapZoomF 
         Caption         =   "自由缩放"
      End
      Begin VB.Menu mnuMapPan 
         Caption         =   "漫游"
      End
      Begin VB.Menu mnuMapViewEn 
         Caption         =   "全幅"
      End
      Begin VB.Menu mnuClear 
         Caption         =   "清空跟踪层"
      End
   End
   Begin VB.Menu mnuSurface 
      Caption         =   "栅格表面分析"
      Begin VB.Menu mnuSurfaceIsoLine 
         Caption         =   "构建所有等值线"
      End
      Begin VB.Menu mnuSurfaceIsolineByPoint 
         Caption         =   "定位生成等值线"
      End
      Begin VB.Menu mnuSurfaceIsolineByValue 
         Caption         =   "定值生成等值线"
      End
      Begin VB.Menu mnuSurfaceSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuSurfaceSlope 
         Caption         =   "坡度图"
      End
      Begin VB.Menu mnuSurfaceAspect 
         Caption         =   "坡向图"
      End
   End
   Begin VB.Menu mnuHydrology 
      Caption         =   "水文分析"
      Begin VB.Menu mnuHydrologyFillSink 
         Caption         =   "填充伪洼地"
      End
      Begin VB.Menu mnuHydrologySink 
         Caption         =   "计算伪洼地"
      End
      Begin VB.Menu mnuHydrologySep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHydrologyFlowDirection 
         Caption         =   "流向分析"
      End
      Begin VB.Menu mnuHydrologySep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHydrologyFlAclation 
         Caption         =   "累计汇水量"
      End
      Begin VB.Menu mnuHydrologySep3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHydrologyFlowLength 
         Caption         =   "坡长分析"
      End
      Begin VB.Menu mnuHydrologyBasin 
         Caption         =   "流域盆地计算"
      End
   End
   Begin VB.Menu mnuStatistic 
      Caption         =   "统计分析"
      Begin VB.Menu mnuStatisticCom 
         Caption         =   "常规分析"
      End
      Begin VB.Menu mnuStatisticNeighbour 
         Caption         =   "邻域分析"
      End
   End
   Begin VB.Menu mnuMath 
      Caption         =   "栅格代数运算"
      Begin VB.Menu mnuMathPlus 
         Caption         =   "加法运算"
      End
      Begin VB.Menu mnuMathMinus 
         Caption         =   "减法运算"
      End
      Begin VB.Menu mnuMathTimes 
         Caption         =   "乘法运算"
      End
      Begin VB.Menu mnuMathDivide 
         Caption         =   "除法运算"
      End
      Begin VB.Menu mnuMathSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMathExcute 
         Caption         =   "表达式"
      End
      Begin VB.Menu mnuMathFloat 
         Caption         =   "转为浮点"
      End
      Begin VB.Menu mnuMathInt 
         Caption         =   "转为整型"
      End
   End
   Begin VB.Menu mnuExchange 
      Caption         =   "数据类型转换"
      Begin VB.Menu mnuExchange2V 
         Caption         =   "栅格->矢量"
      End
      Begin VB.Menu mnuExchange2G 
         Caption         =   "矢量->栅格"
      End
   End
   Begin VB.Menu mnuSet 
      Caption         =   "分析设置"
      Begin VB.Menu mnuSetEnvionment 
         Caption         =   "分析环境设置"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================SuperMap Objects 示范工程说明=======================================
'
'功能简介：示范SuperMap Objects中栅格分析的基本操作：表面分析、水文分析、统计分析、栅格代数运算、数据类型转换等功能
'所用控件：Supermap控件，SuperWorkspace控件和SuperAnalyst控件
'所用数据：data\GridAnalyst\Raster.sdb和Raster.sdd两个文件
'操作说明：
'         1、打开数据源
'         2、点击"分析设置"菜单下的"分析环境设置"菜单，进行栅格分析环境设置
'         3、点击菜单上的表面分析、水文分析、统计分析、栅格代数运算、数据类型转换等子菜单进行栅格分析
'
'===================================SuperMap Objects 示范工程说明结束=====================================
Option Explicit
Public bActiveFrm As Boolean
Public objAnalystEnvmnt As soGridAnalysisEnvironment
Dim strSelectDs As String
Dim strSelectDt As String

Private Sub Form_Load()
    SuperWkspManager.Connect SuperWorkspace.Handle
    SuperMap.Connect frmMain.SuperWorkspace.Handle
    SuperLegend.Connect SuperMap
    SuperAnalyst.Connect SuperWorkspace.Handle
    Set objAnalystEnvmnt = SuperAnalyst.GridAnalyst.AnalysisEnvionment
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objAnalystEnvmnt = Nothing
    SuperLegend.Disconnect
    SuperMap.Disconnect
    SuperAnalyst.Disconnect
    SuperMap.Close
    SuperWkspManager.Disconnect
    SuperWorkspace.Close
End Sub

Private Sub mnuClear_Click()
    SuperMap.TrackingLayer.ClearEvents
    SuperMap.TrackingLayer.Refresh
End Sub

Private Sub mnuExchange2G_Click() '矢量到栅格的转换
    If SuperWorkspace.Datasources.Count < 1 Then Exit Sub
    bActiveFrm = False
    IniComboBox frmVector2Grid.cmbDsList
    IniComboBox frmVector2Grid.cmbDsList2
    IniComboBox frmVector2Grid.cmbDsListResult
    frmVector2Grid.Frame2.Enabled = True
    frmVector2Grid.iChangeType = 2
    frmVector2Grid.txtDataset.Text = "Raster"
    frmVector2Grid.Show vbModal, Me
End Sub

Private Sub mnuExchange2V_Click() '栅格到矢量的转换
    If SuperWorkspace.Datasources.Count < 1 Then Exit Sub
    bActiveFrm = False
    IniComboBox frmVector2Grid.cmbDsList
    IniComboBox frmVector2Grid.cmbDsListResult
    frmVector2Grid.Frame2.Enabled = False
    frmVector2Grid.iChangeType = 1
    frmVector2Grid.txtDataset.Text = "Vector"
    frmVector2Grid.Show vbModal, Me
End Sub

Private Sub mnuFileExit_Click() '退出程序
    Unload Me
End Sub

Private Sub mnuFileOpenDs_Click() '打开数据源
    Dim strFileName As String
    Dim strAlias As String
    Dim objDatasource As soDataSource
    
    With cmDlg
        .CancelError = False
        .InitDir = App.Path & "..\Data\GridAnalyst\"
        .DialogTitle = "打开数据源"
        .Filter = "SuperMap Sdb (*.sdb)|*.sdb"
        .ShowOpen
        strFileName = .FileName
    End With
    If strFileName = "" Then Exit Sub

    strAlias = PathToName(strFileName)
    Set objDatasource = SuperWorkspace.OpenDataSource(strFileName, strAlias, sceSDBPlus, False)
    If objDatasource Is Nothing Then
        MsgBox "打开数据源失败！", vbInformation
        Exit Sub
    End If
    SuperWkspManager.Refresh
    
    Set objDatasource = Nothing
End Sub

Private Sub mnuHydrologyFillSink_Click() '填充伪洼地
    If SuperWorkspace.Datasources.Count < 1 Then Exit Sub
    bActiveFrm = False
    IniComboBox frmHdroFillSink.cmbDsList
    IniComboBox frmHdroFillSink.cmbDsListResult
    frmHdroFillSink.Show vbModal, Me
End Sub

Private Sub mnuHydrologyFlAclation_Click() '累计汇水量
    If SuperWorkspace.Datasources.Count < 1 Then Exit Sub
    bActiveFrm = False
    IniComboBox frmHdroFlAclation.cmbDsList
    IniComboBox frmHdroFlAclation.cmbDsListResult
    frmHdroFlAclation.Show vbModal, Me
End Sub