frmcreatetheme.frm

这是我的一个课题：我省农业分布调查咨询系统。课题是和省农业厅合作的。源代码完整

VERSION 5.00
Begin VB.Form frmCreateTheme 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "创建专题图"
   ClientHeight    =   3885
   ClientLeft      =   3375
   ClientTop       =   2190
   ClientWidth     =   3960
   Icon            =   "frmCreateTheme.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3885
   ScaleWidth      =   3960
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton CancelButton 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   2880
      TabIndex        =   1
      Top             =   1080
      Width           =   975
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   2880
      TabIndex        =   0
      Top             =   360
      Width           =   975
   End
   Begin VB.ListBox MultiFieldsList 
      Height          =   2040
      ItemData        =   "frmCreateTheme.frx":0442
      Left            =   120
      List            =   "frmCreateTheme.frx":0444
      MultiSelect     =   1  'Simple
      TabIndex        =   8
      Top             =   1800
      Width           =   2535
   End
   Begin VB.ComboBox ThemeTypeCombo 
      Height          =   300
      ItemData        =   "frmCreateTheme.frx":0446
      Left            =   120
      List            =   "frmCreateTheme.frx":045F
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1080
      Width           =   2535
   End
   Begin VB.TextBox NameText 
      Height          =   285
      Left            =   120
      TabIndex        =   7
      Top             =   360
      Width           =   2535
   End
   Begin VB.ListBox SingleFieldsList 
      Height          =   2040
      Left            =   120
      TabIndex        =   5
      Top             =   1800
      Visible         =   0   'False
      Width           =   2535
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "专题图名称 (可不输):"
      Height          =   180
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   1800
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "请选择创建专题图的条目："
      Height          =   180
      Left            =   120
      TabIndex        =   4
      Top             =   1560
      Width           =   2160
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "请选择专题图类型："
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   840
      Width           =   1620
   End
End
Attribute VB_Name = "frmCreateTheme"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' This sample application and corresponding sample code is provided
' for example purposes only.  It has not undergone rigorous testing
' and as such should not be shipped as part of a final application
' without extensive testing on the part of the organization releasing
' the end-user product.

Option Explicit

Private Sub CancelButton_Click()
    Unload frmCreateTheme
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 db As Database
'     Dim myRS As Recordset
'     Set db = OpenDatabase("d:\agricultural_query\scdb_yearsdata.mdb")
'     Set myRS = db.OpenRecordset("1g12_1999")
'     fMainForm.Map1.Datasets.Add miDataSetDAO, myRS, "1g12_1999", "行政代码", , "1g12"  '为作专题图创建的dataset
    ' 设置缺省的专题图类型为“自动”
    ThemeTypeCombo.ListIndex = 6
End Sub

Private Sub OKButton_Click()
    Dim ThemeType As Integer
    Dim IsMultivariateTheme As Boolean
    Dim ds As Dataset
    ' The creation of themes can take a while, so show an hourglass while
    ' MapX is working
    frmCreateTheme.MousePointer = ccHourglass
    Set ds = fMainForm.Map1.Datasets.Item("1g12_1999")

    ' 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
    
    Set fMainForm.Map1.Bounds = fMainForm.Map1.Layers("1g12").Bounds

    If IsMultivariateTheme = False Then
        If SingleFieldsList.ListIndex = -1 Then
            MsgBox "请选择您需要的条目创建专题图", , "提示信息"
            frmCreateTheme.MousePointer = ccDefault
            Exit Sub
        End If
                        
        If NameText.Text <> "" Then
            ds.Themes.Add ThemeType, SingleFieldsList.Text, NameText.Text
        Else
            ds.Themes.Add ThemeType, SingleFieldsList.Text
        End If
    Else
        If MultiFieldsList.SelCount = 0 Then
            MsgBox "请选择您需要的条目创建专题图", , "提示信息"
            frmCreateTheme.MousePointer = ccDefault
            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)
        For i = 0 To MultiFieldsList.ListCount - 1
        If MultiFieldsList.Selected(i) Then
            ' 将选中的字段添加到fieldslist
            FieldList(j) = MultiFieldsList.List(i)
            j = j + 1
        End If
        Next
        If NameText.Text <> "" Then
              ds.Themes.Add ThemeType, FieldList, NameText.Text
        Else
              ds.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
    Unload frmSelectPoint
    Unload frmSelectnone
    Unload frmselectmore
    Unload frminfo
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("1g12_1999")
        
    ' 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
    'For Each ds In fMainForm.Map1.Datasets
    
        If ThemeTypeCombo.ListIndex = 5 Then
            For Each fld In ds.Fields
                'If fld <> "图斑编码" And fld <> "图斑面积平方米" And fld <> "年份" Then
                
                SingleFieldsList.AddItem fld
                MultiFieldsList.AddItem fld
                
                'End If
            Next
        Else
            ' Don't allow the text fields
            For Each fld In ds.Fields
                If fld.Type = miTypeNumeric Then
                  ' If fld <> "图斑面积平方米" Then
                        SingleFieldsList.AddItem fld
                        MultiFieldsList.AddItem fld
                   'End If
                End If
            Next
        End If
    
   ' Next
End Sub