m_general.bas

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

Attribute VB_Name = "m_General"
Option Explicit

Public Sub ChangeDs(strDs As String, objCmb As ComboBox)
    Dim strDt As String
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim i As Integer
    Dim iCnt As Integer
    
    Set objDs = frmMain.SuperWorkspace.Datasources(strDs)
    If Not objDs Is Nothing Then
        iCnt = objDs.Datasets.Count
        If iCnt > 0 Then
            objCmb.Clear
            For i = 1 To iCnt
                Set objDt = objDs.Datasets(i)
                If objDt.Type = scdDEM Or objDt.Type = scdGrid Then
                    strDt = objDt.Name
                    objCmb.AddItem strDt
                End If
            Next i
        Else
            objCmb.Clear
        End If
        If objCmb.ListCount > 0 Then objCmb.ListIndex = 0
        objCmb.Refresh
    Else
        MsgBox "获取数据源失败", vbInformation, "信息提示"
    End If
    Set objDt = Nothing
    Set objDs = Nothing
End Sub


Public Sub ChangeDs2(strDs As String, objCmb As ComboBox)
    Dim strDt As String
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim i As Integer
    Dim iCnt As Integer
    
    Set objDs = frmMain.SuperWorkspace.Datasources(strDs)
    If Not objDs Is Nothing Then
        iCnt = objDs.Datasets.Count
        If iCnt > 0 Then
            objCmb.Clear
            For i = 1 To iCnt
                Set objDt = objDs.Datasets(i)
                If objDt.Type <> scdTabular Or objDt.Type <> scdParcel Then
                    strDt = objDt.Name
                    objCmb.AddItem strDt
                End If
            Next i
        Else
            objCmb.Clear
        End If
        If objCmb.ListCount > 0 Then objCmb.ListIndex = 0
        objCmb.Refresh
    Else
        MsgBox "获取数据源失败", vbInformation, "信息提示"
    End If
    Set objDt = Nothing
    Set objDs = Nothing
End Sub

Public Sub ChangeDt(strDs As String, strDt As String, objCmb As ComboBox)
    Dim strTmp As String
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim objDtv As soDatasetVector
    Dim i As Integer
    Dim iCnt As Integer
    Dim iType As Integer
    
    Set objDs = frmMain.SuperWorkspace.Datasources(strDs)
    If Not objDs Is Nothing Then
        Set objDt = objDs.Datasets(strDt)
        If objDt.Vector Then
            Set objDtv = objDt
            iCnt = objDtv.FieldCount
            If iCnt > 0 Then
                objCmb.Clear
                For i = 1 To iCnt
                    iType = objDtv.GetFieldInfo(i).Type
                    If iType = 3 Or iType = 4 Or iType = 6 Or iType = 7 Or iType = 19 Then
                        strTmp = objDtv.GetFieldInfo(i).Name
                        objCmb.AddItem strTmp
                    End If
                Next i
            Else
                objCmb.Clear
            End If
            If objCmb.ListCount > 0 Then objCmb.ListIndex = 0
            objCmb.Refresh
        End If
    Else
        MsgBox "获取数据源失败", vbInformation, "信息提示"
    End If
    
    Set objDtv = Nothing
    Set objDt = Nothing
    Set objDs = Nothing
End Sub


Public Function DataSetName(objDs As soDataSource, strDtName) As String
    Dim i As Integer
    Dim bAlias As Boolean
    bAlias = objDs.IsAvailableDatasetName(strDtName)
    If bAlias Then
        DataSetName = strDtName
    Else
        For i = 1 To 10
            bAlias = objDs.IsAvailableDatasetName(strDtName & "_" & i)
            If bAlias Then
                DataSetName = strDtName & "_" & i
                Exit For
            End If
        Next i
        If bAlias = False Then
            MsgBox "请重新设置一个结果数据集名", vbInformation, "信息提示"
            DataSetName = ""
        End If
    End If
End Function