frmcreatetheme.frm

一个交通专用的gis-T系统

VERSION 5.00
Begin VB.Form frmCreateTheme 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "生成专题图窗口"
   ClientHeight    =   4710
   ClientLeft      =   3375
   ClientTop       =   2190
   ClientWidth     =   4800
   Icon            =   "frmCreateTheme.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4710
   ScaleWidth      =   4800
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton CancelButton 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   3480
      TabIndex        =   1
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   3480
      TabIndex        =   0
      Top             =   360
      Width           =   1215
   End
   Begin VB.ListBox MultiFieldsList 
      Height          =   2040
      Left            =   120
      MultiSelect     =   1  'Simple
      TabIndex        =   10
      Top             =   2400
      Width           =   3135
   End
   Begin VB.ComboBox ThemeTypeCombo 
      Height          =   315
      ItemData        =   "frmCreateTheme.frx":0442
      Left            =   120
      List            =   "frmCreateTheme.frx":045B
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   1680
      Width           =   3135
   End
   Begin VB.TextBox NameText 
      Height          =   285
      Left            =   120
      TabIndex        =   9
      Top             =   1080
      Width           =   3135
   End
   Begin VB.ComboBox DatasetCombo 
      Height          =   315
      Left            =   120
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   360
      Width           =   3135
   End
   Begin VB.ListBox SingleFieldsList 
      Height          =   2040
      Left            =   120
      TabIndex        =   7
      Top             =   2400
      Visible         =   0   'False
      Width           =   3135
   End
   Begin VB.Label Label4 
      Caption         =   "专题图名称（可选）："
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   840
      Width           =   2775
   End
   Begin VB.Label Label3 
      Caption         =   "专题图的字段："
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   2160
      Width           =   2055
   End
   Begin VB.Label Label2 
      Caption         =   "专题图类型："
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   1440
      Width           =   2295
   End
   Begin VB.Label Label1 
      Caption         =   "数据集"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   1575
   End
End
Attribute VB_Name = "frmCreateTheme"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************
'*
'*                本源码完全免费，共交通同仁学习参考                 *
'*                      www.tranbbs.com                              *
'*                   Developed by Yang Ming                          *
'*       Nanjing Institute of City Transportation Planning           *
'*                 请保留本版权信息，谢谢合作                        *
'*                      中国交通技术论坛                             *
'*                                                                   *
'*                                                                   *
'*********************************************************************

Option Explicit

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub DatasetCombo_Click()
    ' Since each different dataset has different fields, we need to change the
    ' field list when the dataset chosen changes.
    
    RefillFieldsList
End Sub

Private Sub Form_Load()
    Dim ds As Dataset
    ' List all the datasets in the dataset combobox
    For Each ds In Main.Mapshow.Datasets
        DatasetCombo.AddItem ds.Name
    Next
    DatasetCombo.ListIndex = 0
    
    ' Set the default theme type to be "Auto"
    ThemeTypeCombo.ListIndex = 6
End Sub

Private Sub OKButton_Click()
    Dim ThemeType As Integer
    Dim IsMultivariateTheme As Boolean
    
    ' The creation of themes can take a while, so show an hourglass while
    ' MapX is working
    frmCreateTheme.MousePointer = ccHourglass
    
    ' Identify which type of theme the user selected, and whether it accepts
    ' multiple fields
    Select Case ThemeTypeCombo.ListIndex
        Case 0 ' Ranged Theme
            ThemeType = miThemeRanged
            IsMultivariateTheme = False
        Case 1 ' Bar Chart
            ThemeType = miThemeBarChart
            IsMultivariateTheme = True
        Case 2 ' Pie Chart
            ThemeType = miThemePieChart
            IsMultivariateTheme = True
        Case 3 ' Graduated Symbol
            ThemeType = miThemeGradSymbol
            IsMultivariateTheme = False
        Case 4 ' Dot Density
            ThemeType = miThemeDotDensity
            IsMultivariateTheme = False
        Case 5 ' Individual Value
            ThemeType = miThemeIndividualValue
            IsMultivariateTheme = False
        Case 6 ' Auto
            ThemeType = miThemeAuto
            IsMultivariateTheme = True
    End Select
    
    If IsMultivariateTheme = False Then
        If SingleFieldsList.ListIndex = -1 Then
            MsgBox "Please select a field to theme."
            Exit Sub
        End If
                        
        If NameText.Text <> "" Then
            fMainForm.Map1.Datasets.Item(DatasetCombo.Text).Themes.Add ThemeType, SingleFieldsList.Text, NameText.Text
        Else
            fMainForm.Map1.Datasets.Item(DatasetCombo.Text).Themes.Add ThemeType, SingleFieldsList.Text
        End If
    Else
        If MultiFieldsList.SelCount = 0 Then
            MsgBox "Please select field(s) to theme."
            Exit Sub
        End If
        
        Dim j As Integer
        Dim i As Integer
        i = 1
        j = 1
        Dim FieldList() As String
        ReDim FieldList(1 To MultiFieldsList.SelCount)

        ' Since there are multiple fields, we need to build a list of strings
        For i = 0 To MultiFieldsList.ListCount - 1
            If MultiFieldsList.Selected(i) Then
                ' This is a selected field, so add to the list of strings
                FieldList(j) = MultiFieldsList.List(i)
                j = j + 1
            End If
        Next
 
        If NameText.Text <> "" Then
            fMainForm.Map1.Datasets.Item(DatasetCombo.Text).Themes.Add ThemeType, FieldList, NameText.Text
        Else
            fMainForm.Map1.Datasets.Item(DatasetCombo.Text).Themes.Add ThemeType, FieldList
        End If
    End If
    
    ' Restore the cursor which was changed at the beginning of this subroutine.
    frmCreateTheme.MousePointer = ccDefault
    Unload Me
End Sub

Private Sub ThemeTypeCombo_Click()
    ' Since there are two list boxes (MultiFieldsList and SingleFieldsList), one
    ' with multiple selection for the theme types that require multiple fields and
    ' one with single selection for the monovariate themes, the visiblity of them
    ' needs to be changed when the Theme Type selection changes
    Select Case ThemeTypeCombo.ListIndex
        Case 0, 3, 4, 5 ' monovariate themes
            SingleFieldsList.Visible = True
            SingleFieldsList.ListIndex = MultiFieldsList.ListIndex
            MultiFieldsList.Visible = False
        Case 1, 2, 6 ' multivariate themes
            MultiFieldsList.Visible = True
            MultiFieldsList.ListIndex = SingleFieldsList.ListIndex
            SingleFieldsList.Visible = False
    End Select
    
    ' Since the eligible fields change depending on if the theme can handle text
    ' fields, we need to refill the fields list
    RefillFieldsList
End Sub

Private Sub RefillFieldsList()
    Dim i As Integer
    Dim ds As Dataset
    Dim fld As mapxlib.Field
    
    If DatasetCombo.ListIndex = -1 Then
        Exit Sub
    End If
    
    ' First, remove all the existing fields
    For i = 0 To SingleFieldsList.ListCount - 1
        SingleFieldsList.RemoveItem 0
        MultiFieldsList.RemoveItem 0
    Next
    
    ' This is the dataset that the user just chose
    Set ds = fMainForm.Map1.Datasets.Item(DatasetCombo.Text)
        
    ' And add in the fields from the new dataset
    ' All the theme types besides Individual Value cannot handle
    ' text data, so, if the field type is text, do not add it to the list
    If ThemeTypeCombo.ListIndex = 5 Then
        For Each fld In ds.Fields
            SingleFieldsList.AddItem fld
            MultiFieldsList.AddItem fld
        Next
    Else
        ' Don't allow the text fields
        For Each fld In ds.Fields
            If fld.Type = miTypeNumeric Then
                SingleFieldsList.AddItem fld
                MultiFieldsList.AddItem fld
            End If
        Next
    End If
End Sub