⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmdatasets.frm

📁 GIS地理信息系统开发。大名鼎鼎的MAPX+VisualBasic6.0软件开发
💻 FRM
📖 第 1 页 / 共 2 页
字号:
Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub DatasetList_Click()
    ' Now, the user has selected a table to add, so the OK button should be enabled
    OKButton.Enabled = True
End Sub

Private Sub DatasetList_DblClick()
    If OKButton.Enabled = True Then
        OKButton_Click
    End If
End Sub

Private Sub Form_Load()
    Dim Table As TableDef
    Dim ds As Dataset
    Dim i As Integer
    
    ' In this dialog, there is an "Advanced" button which will show several advanced
    ' options.  This is done by making the dialog smaller to hide the options, and larger
    ' to reveal them.  By default, they are hidden, so we must make the dialog small here.
    frmDatasets.Height = 3450
    
    ' Open the database if it hasn't already been opened
    If MapDataOpen <> True Then
        ' OpenMapData tries to open the database, and returns true if it was successful
        If OpenMapData = False Then
            Exit Sub
        End If
    End If
    
    ' This code may look ugly, but all it's doing is filling the Dataset list with
    ' the names of all the tables in the database. The "MSys" bit is to make sure
    ' we don't list any system tables
    For Each Table In MapData.TableDefs
        If Left$(Table.Name, 4) <> "MSys" Then
            DatasetList.AddItem Table.Name
        End If
    Next
    ' But, we don't want to list tables that the user has already added, so remove
    ' all the names from that list that are already MapX datasets
    For Each ds In fMainForm.Map1.Datasets
        For i = 0 To DatasetList.ListCount
            If DatasetList.List(i) = ds.Name Then
                DatasetList.RemoveItem i
            End If
        Next
    Next
    
    DatabindCombo.ListIndex = 0 ' The default databinding type is "Normal"
    
    ' Since Zip Code databinding only works if there's a zipcode layer in the
    ' geoset, disable this option if the current geoset doesn't have a zipcode layer.
    ' Currently, the only geosets that do have one are US and Washington, DC
    If fMainForm.Map1.Geoset <> "United States" And fMainForm.Map1.Geoset <> "DC Metro" Then
        DatabindCombo.RemoveItem 2
    End If
End Sub

Private Function OpenMapData() As Boolean
    ' First, bring in the Map data into a dataset.
    ' A dataset is needed to create a theme.  In this case, the example data
    ' in the Access Database Mapstats.mdb is used.
    ' Try to find the Mapstats file; if it is not in the default location, we
    ' ask the user to find it.  We store this as a setting so we only have to
    ' do this once for each machine.
    Dim DBName As String
    
    DBName = GetSetting(App.Title, "Settings", "MapDatabasePath", "C:\Program Files\MapInfo MapX 4.0\Data\Mapstats.mdb")
    
    ' See if this file in the settings exists
    If Dir(DBName) <> "" Then ' It exists
        On Error GoTo DBNotFound
        Set MapData = OpenDatabase(DBName)
        MapDataOpen = True
        OpenMapData = True ' The database opening was successful
        Exit Function
    End If

    ' The settings path is not correct, so we ask the user to find the database
    
    MsgBox "Please locate ""Mapstats.mdb"" in the ""Data"" subdirectory of the MapX directory."
    On Error GoTo DBNotFound
    With dlgCommonDialog
        .DialogTitle = "Locate Mapstats.mdb"
        .Flags = 0
        .CancelError = True
        .FileName = ""
        .Filter = "Access Databases (*.mdb)|*.mdb"
        .ShowOpen
        If Len(.FileName) = 0 Then
            GoTo DBNotFound
        End If
        DBName = .FileName
    End With
    
    ' The user located the database, so open it
    Set MapData = OpenDatabase(DBName)
    MapDataOpen = True
    OpenMapData = True
    
    ' Store this path as a setting so we can find it next time
    SaveSetting App.Title, "Settings", "MapDatabasePath", DBName
    
    Exit Function

DBNotFound:
    If Err = 32755 Then ' Cancel was selected
        MsgBox "Could not locate the MapStats database. No Data was imported."
    Else
        MsgBox "Could not find Map data to import. Error #" & Str(Err) & ": " & Error
    End If
    MapDataOpen = False
    OpenMapData = False ' The opening of the database was unsuccessful
End Function

Private Sub OKButton_Click()
    ' This shouldn't happen because the OK button is disabled whenever there is no
    ' selection.  If it does happen, however, just exit
    If DatasetList.ListIndex = -1 Then
        Unload Me
        Exit Sub
    End If

    ' Importing data into datasets can take a long time, so show an hourglass
    ' while MapX is working.
    frmDatasets.MousePointer = ccHourglass
    
    Dim rs As Recordset
    Set rs = MapData.TableDefs(DatasetList.Text).OpenRecordset

    ' Identify the data binding type and add the dataset
    Dim BindLyr As New BindLayer
    Select Case DatabindCombo.ListIndex
        Case 0 ' Normal
            ' Add the dataset, binding normally.  Let MapX automatically pick the
            ' layer and Geofield to bind to.
            BindLyr.LayerType = miBindLayerTypeNormal
            
            ' Special Case: When binding the sample table named "USA" to
            ' the US map, the layer to bind to must be specified (the
            ' States layer), or  it will be incorrectly bound to the
            ' counties layer
            If fMainForm.Map1.Geoset = "United States" And rs.Name = "Usa" Then
                BindLyr.LayerName = "USA" ' bind to the states layer
            End If
            
            fMainForm.Map1.Datasets.Add miDataSetDAO, rs, rs.Name, , , BindLyr
        Case 1 ' X,Y binding
            ' When binding with type XY, Refcolumn1 is the name of the column with
            ' the X coordinates, Refcolumn2 is the name of the column with the Y coordinates
            BindLyr.LayerType = miBindLayerTypeXY
            BindLyr.RefColumn1 = "X"
            BindLyr.RefColumn2 = "Y"
            
            ' Add the dataset.  We use "X" as the primary geofield and "Y" as the secondary,
            ' since the pair should form a unique identifier.  If it is not unique (i.e two
            ' points in the data are the same), the data will be aggregated.
            fMainForm.Map1.Datasets.Add miDataSetDAO, rs, rs.Name, "X", "Y", BindLyr
        Case 2 ' Zip Code binding
            Dim ZipFieldName As String
            Dim fld As DAO.Field
            
            ' First, we find the field that contains the zipcode by finding the first
            ' field that begins with "ZIP"
            For Each fld In rs.Fields
                If Left$(fld.Name, 3) = "ZIP" And ZipFieldName = "" Then
                    ' found it
                    ZipFieldName = fld.Name
                End If
            Next
            ' Now, the zipcode field is in ZipFieldName
            
            ' When binding with type pointref, Refcolumn1 is the name of the column
            ' with the reference (in this case, zipcode) in it.
            BindLyr.LayerType = miBindLayerTypePointRef
            BindLyr.RefColumn1 = ZipFieldName
    
            ' The reference layer is the layer that contains the points that
            ' correspond to the reference.  In the Zipcode example, it is the
            ' zipcode layer. Here, we set this to the US zipcodes layer or the
            ' DC zipcodes layer depending on the Geoset.
            ' Note: MapX can find this layer automatically for you, so it's not
            ' necessary for correct operation
            If fMainForm.Map1.Geoset = "United States" Then
                BindLyr.ReferenceLayer = "US 5 Digit Zipcode Centers"
            End If
            If fMainForm.Map1.Geoset = "DC Metro" Then
                BindLyr.ReferenceLayer = "DC Zipcodes"
            End If
    
            ' Add the dataset. We use the zip field as the primary geofield, which
            ' should be unique in the dataset. If it is not, the data will be aggregated
            fMainForm.Map1.Datasets.Add miDataSetDAO, rs, rs.Name, ZipFieldName, , BindLyr
    End Select
    
    ' Restore the mouse pointer
    frmDatasets.MousePointer = ccDefault
    
    Unload Me
End Sub
 

⌨️ 快捷键说明

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