mdufunction.bas

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

Attribute VB_Name = "MduFunction"
Option Explicit

Public Function IsDatasetInUse(strDtName As String, strDsName As String)
'===============================================================================
'自定义函数,检测数据源是否正在使用,即地图窗口中的图层的数据集为数据源中的元素
'如果数据源正在使用,则不能删除 .用于删除数据源,数据集操作.
'===============================================================================
    Dim objlayer As soLayer
    Dim obj3DDataset As soDataset
    Dim strName As String
    Dim bUse As Boolean
    Dim i As Integer
    Dim iLayerID As Long
    
    bUse = False
    IsDatasetInUse = False
    strName = strDtName & "@" & strDsName
    For i = Forms.Count - 1 To 1 Step -1
        If Forms(i).Name = "frmDocument" Then
            If Forms(i).SuperMap1.Visible = True Then
                '检查是否被SupeMap使用
                For Each objlayer In Forms(i).SuperMap1.Layers
                    If UCase$(objlayer.Name) = UCase$(strName) Then
                    bUse = True
                    Exit For
                    End If
                Next
                If bUse = True Then
                    '============删除图层方式=========================================
                    iLayerID = Forms(i).SuperMap1.Layers.FindLayer(objlayer)
                    Set objlayer = Nothing
                    Forms(i).SuperMap1.Layers.RemoveAt (iLayerID)
                    Forms(i).SuperMap1.Refresh
                    
                    Set objlayer = Nothing
                    bUse = False
                End If
            End If
            Unload Forms(i)
        End If
    Next
    
    Set objlayer = Nothing
    Set obj3DDataset = Nothing
End Function

Public Sub OnAddDSToTreeView(objds As soDataSource, tvwManager As TreeView, strWorkSpaceName As String)
    Dim strDsKey As String
    Dim iDtTypeImgIndex As Long
    Dim j As Integer
    
    strDsKey = "A" & objds.Alias
    
    '添加数据源
    tvwManager.Nodes.Add "W" & strWorkSpaceName, tvwChild, strDsKey, objds.Alias, 24, 25
    
    If objds.Datasets.Count = 0 Then
        MsgBox objds.Name & "数据源中没有数据集", vbInformation
    Else
        '提取数据源信息添加到TreeView
        For j = 1 To objds.Datasets.Count
            Select Case objds.Datasets.Item(j).Type
                Case scdPoint
                    iDtTypeImgIndex = 53
                Case scdPointZ
                    iDtTypeImgIndex = 47
                Case scdLine
                    iDtTypeImgIndex = 67
                Case scdRegion
                    iDtTypeImgIndex = 33
                Case scdText
                    iDtTypeImgIndex = 65
                Case scdNetwork
                    iDtTypeImgIndex = 32
                Case scdGrid
                    iDtTypeImgIndex = 34
                Case scdImage
                    iDtTypeImgIndex = 36
                Case scdTIN
                    iDtTypeImgIndex = 35
                Case scdDEM
                    iDtTypeImgIndex = 72
                Case scdECW
                    iDtTypeImgIndex = 73
                Case scdMrSID
                    iDtTypeImgIndex = 74
                Case scdCAD
                    iDtTypeImgIndex = 70
                Case scdTabular
                    iDtTypeImgIndex = 71
                Case Else
                    iDtTypeImgIndex = 23
            End Select
            tvwManager.Nodes.Add strDsKey, tvwChild, , objds.Datasets.Item(j).Name, iDtTypeImgIndex
        Next j
    End If
    tvwManager.Refresh
End Sub

Public Sub OnFileCloseWorkspace()
    frmMain.Super3D1.Layer3Ds.RemoveAll
    frmMain.Super3D1.Refresh
    frmMain.Super3DLegend1.Refresh
    frmMain.SuperWorkspace1.Close
    frmMain.TreeViewData.Nodes.Clear
    frmMain.TreeViewData.Nodes.Add , , "WORKSPACE", "工作空间", 5
    frmMain.TreeViewMap.Nodes.Clear
    frmMain.TreeViewMap.Nodes.Add , , "WORKSPACE", "工作空间", 5
End Sub