📄 frmmain.frm

📁 都是基于VB所做的程序集合,值得大家作为实践的参考资料.
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
      BackColor       =   &H8000000A&
      Caption         =   "平面窗口"
      Height          =   6840
      Left            =   6750
      TabIndex        =   3
      Top             =   0
      Width           =   4935
      Begin SuperMapLib.SuperMap SuperMap 
         Height          =   6465
         Left            =   105
         TabIndex        =   15
         Top             =   285
         Width           =   4725
         _Version        =   327682
         _ExtentX        =   8334
         _ExtentY        =   11404
         _StockProps     =   160
      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的三维分析功能：Tin的生成和由Tin生成等高线。
'所用控件：SuperMap Objects的核心(supermap,superworkspace)控件和Super3D控件
'所用数据: ..\Data\3DAnalyst\Tin.sdb和Tin.sdd文件
'操作说明：在"数据列表"中选中一个数据集，能操作的按钮会可用
'         1、选择任意一个数据集，单击"平面窗口显示",则在右边的"平面窗口"中显示该数据集；
'         2、选择一个TIN数据集，单击"三维窗口显示",则在左边的"三维窗口"中显示该数据集的三维模型；
'         3、选择一个点或线类型的数据集，单击"生成TIN",则会出现一个生成TIN的对话框，选择相应属性,按确
'            定按钮则自动生成一个新的TIN类型的数据集；
'         4、选择一个TIN数据集，单击"TIN->等高线"，则会出现一个对话框，选择或填写相应属性，按确定按钮则自动
'            由TIN数据集生成一个线类型的数据集.
'===================================SuperMap Objects示范工程说明结束=====================================
Option Explicit
Dim dX As Double, dY As Double
Private Sub btnCreateTin_Click()
    Select Case Me.tvwDataSource.SelectedItem.Image
        Case 3            '点->Tin
            frmtoTin.iWhat = 2
            frmtoTin.txtLen.Enabled = False
            frmtoTin.txtLen.BackColor = &H80000004
            frmtoTin.Label2.Enabled = False
        Case 4            '三维点->Tin
            frmtoTin.iWhat = 3
            frmtoTin.cmbFieldZ.Enabled = False
            frmtoTin.cmbFieldZ.BackColor = &H80000004
            frmtoTin.Label1.Enabled = False
            frmtoTin.txtLen.Enabled = False
            frmtoTin.txtLen.BackColor = &H80000004
            frmtoTin.Label2.Enabled = False
        Case 5, 6           '等高线->Tin
            frmtoTin.iWhat = 1
    End Select
        frmtoTin.Show vbModal, Me
End Sub

Private Sub btnDisply3DWin_Click() '三维窗口显示
    Dim DS As soDataSource
    Dim Dt As soDataset
    Dim strDsName As String
    
    strDsName = frmMain.tvwDataSource.SelectedItem.Parent.Text
    
    Set DS = frmMain.SuperWorkspace.Datasources.Item(strDsName)
    If DS Is Nothing Then
        MsgBox "获取数据源失败！", vbInformation
        Exit Sub
    End If
    Set Dt = DS.Datasets.Item(frmMain.tvwDataSource.SelectedItem.Text)
        If Dt Is Nothing Then
        MsgBox "获取数据集失败！", vbInformation
        Set DS = Nothing
        Exit Sub
    End If
    
    If (Dt.Type = 84 Or Dt.Type = 139) Then '如果是DEM或TIN等三维数据集
        If Super3D.Layer3Ds.Count > 0 Then Super3D.Layer3Ds.RemoveAll
        Super3D.Layer3Ds.AddDataset Dt, True
        Super3D.Refresh   '刷新三维窗口中的三维模型
    Else
        MsgBox "请选择三维数据集"
        Exit Sub
    End If
    
    
    Set DS = Nothing                              '释放内存
    Set Dt = Nothing
End Sub

Private Sub btnDisplyMapWin_Click() '平面窗口显示
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim strName As String
    
    If tvwDataSource.SelectedItem.Parent Is Nothing Then Exit Sub
    Set objDs = SuperWorkspace.Datasources(tvwDataSource.SelectedItem.Parent.Text)
    If objDs Is Nothing Then
        MsgBox "打开数据源失败!", vbInformation
    Else
        strName = tvwDataSource.SelectedItem.Text
        Set objDt = objDs.Datasets(strName)
        If objDt Is Nothing Then
            MsgBox "打开数据集失败!", vbInformation
            Exit Sub
        End If
        SuperMap.Layers.RemoveAll                 '从图层集中删除所有图层
        SuperMap.Layers.AddDataset objDt, True   '将数据集添加到SuperMap的最底层
        SuperMap.ViewEntire                       '全幅显示
        SuperMap.Refresh                          '刷新地图窗口
    End If
End Sub

Private Sub btnEntire_Click() '全幅
    SuperMap.ViewEntire
    Super3D.RestoreScene
    Super3D.Refresh
End Sub

Private Sub btnPan_Click()
    SuperMap.Action = scaPan
    Super3D.Action = sca3DPan
End Sub

Private Sub btnTinToContour_Click()                         'Tin->等高线
    frmTinToContour.Show vbModal, Me
End Sub

Private Sub btnExit_Click()                                 '退出
    Unload Me
End Sub

Private Sub btnZoomIn_Click()
    SuperMap.Action = scaZoomIn
    Super3D.Action = sca3DZoomIn
End Sub

Private Sub btnZoomOut_Click()
    SuperMap.Action = scaZoomOut
    Super3D.Action = sca3DZoomOut
End Sub

Private Sub Form_Load()
    SuperMap.Connect SuperWorkspace.Handle                '建立地图与工作空间的连接
    Super3D.Connect SuperWorkspace.Handle
    
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim i As Integer, nDtCount As Integer
    Dim iImgIndex As Integer
    
    Set objDs = SuperWorkspace.OpenDataSource(App.Path & "\..\Data\3DAnalyst\Tin.sdb", "Tin", sceSDBPlus, False)
    If objDs Is Nothing Then
        MsgBox "打开数据源文件失败！", vbInformation
    Else
        tvwDataSource.Nodes.Add , tvwFirst, objDs.Alias, objDs.Alias, 2, 1
        nDtCount = objDs.Datasets.Count
        For i = 1 To nDtCount
            Set objDt = objDs.Datasets.Item(i)
            Select Case objDt.Type   '数据集类型
                Case scdPoint                 '点数据集
                    iImgIndex = 3
                Case scdPointZ                '三维点数据集
                    iImgIndex = 4
                Case scdLine                  '线数据集
                    iImgIndex = 5
                Case scdNetwork               '网络数据集
                    iImgIndex = 6
                Case scdRegion                '面数据集
                    iImgIndex = 8
                Case scdText                  '文本数据集
                    iImgIndex = 7
                Case scdImage                 '影像数据集
                    iImgIndex = 9
                Case scdCAD                   'CAD数据集
                    iImgIndex = 10
                Case scdECW                   'ECW数据集
                    iImgIndex = 11
                Case scdMrSID                 'MrSid数据集
                    iImgIndex = 12
                Case scdTIN                   'Tin数据集
                    iImgIndex = 14
                Case scdDEM                   'DEM数据集
                    iImgIndex = 15
                Case Else                     '其他类型数据集
                    iImgIndex = 13
            End Select
            
            tvwDataSource.Nodes.Add objDs.Alias, tvwChild, , objDt.Name, iImgIndex
        Next
        
        tvwDataSource.Nodes(1).Expanded = True    '设置该 Node 当前被展开
        
        Set tvwDataSource.SelectedItem = tvwDataSource.Nodes(1)
    End If
    
    Set objDs = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SuperMap.Close
    SuperMap.Disconnect
    
    Super3D.Close
    Super3D.Disconnect
    
    SuperWorkspace.Close
End Sub

Private Sub tvwDataSource_NodeClick(ByVal Node As MSComctlLib.Node)
    If Node.Parent Is Nothing Then                  '所选不是图层
        btnDisply3DWin.Enabled = False
        btnDisplyMapWin.Enabled = False
        btnCreateTin.Enabled = False
        btnTinToContour.Enabled = False
    ElseIf (Node.Image = 14) Then                   'Tin图层
        btnDisply3DWin.Enabled = True
        btnDisplyMapWin.Enabled = True
        btnCreateTin.Enabled = False
        btnTinToContour.Enabled = True
    ElseIf (Node.Image = 15) Then                   'DEM图层
        btnDisply3DWin.Enabled = False
        btnDisplyMapWin.Enabled = True
        btnCreateTin.Enabled = False
        btnTinToContour.Enabled = False
    Else                                            '其他类型图层
        btnDisply3DWin.Enabled = False
        btnDisplyMapWin.Enabled = True
        btnCreateTin.Enabled = True
        btnTinToContour.Enabled = False
    End If
End Sub
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -