modifytheme.frm

GIS地理信息系统开发。大名鼎鼎的MAPX＋VisualBasic6.0软件开发

VERSION 5.00
Begin VB.Form ModifyTheme 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Modify Theme"
   ClientHeight    =   1335
   ClientLeft      =   1230
   ClientTop       =   1740
   ClientWidth     =   7590
   Icon            =   "ModifyTheme.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1335
   ScaleWidth      =   7590
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdLegend 
      Caption         =   "&Legend..."
      Height          =   375
      Left            =   3240
      TabIndex        =   4
      Top             =   780
      Width           =   1215
   End
   Begin VB.CommandButton cmdModify 
      Caption         =   "&Modify..."
      Height          =   375
      Left            =   1800
      TabIndex        =   3
      Top             =   780
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   375
      Left            =   4680
      TabIndex        =   2
      Top             =   780
      Width           =   1215
   End
   Begin VB.ComboBox cmbThemes 
      Height          =   315
      ItemData        =   "ModifyTheme.frx":000C
      Left            =   1440
      List            =   "ModifyTheme.frx":000E
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   180
      Width           =   5955
   End
   Begin VB.Label lblTheme 
      Caption         =   "Choose &theme:"
      Height          =   255
      Left            =   180
      TabIndex        =   0
      Top             =   240
      Width           =   1155
   End
End
Attribute VB_Name = "ModifyTheme"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' 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.

Dim gMap As Map, TD() As ThemeDescr

Public Sub Activate(mapxMap As Map)
  Set gMap = mapxMap
  InitThemes
  RangeOptions.bOptionsSet = False
  BarOptions.bOptionsSet = False
  PieOptions.bOptionsSet = False
  GradOptions.bOptionsSet = False
  LegendStyle.bLegendSet = False
  If cmbThemes.ListCount = 0 Then
    Exit Sub
  End If
  FormToCenter hWnd
  Show ' 1
End Sub

Private Sub InitThemes()
  Dim i As Integer

  FillThemes TD, gMap
  If UBound(TD) = 0 Then
    Hide
    Exit Sub
  End If
  cmbThemes.Clear
  For i = 1 To UBound(TD)
    cmbThemes.AddItem TD(i).ThemeString
  Next
  cmbThemes.ListIndex = 0
End Sub

Private Sub cmdCancel_Click()
  Hide
End Sub

Private Sub cmdLegend_Click()
  Dim curTheme As Theme

  Set curTheme = GetThemeSelected
  LegendStyle.bCompact = curTheme.Legend.Compact
  LegendStyle.bVisible = curTheme.Legend.Visible
  LegendStyle.bCurrency = curTheme.Legend.CurrencyFormat
  LegendStyle.bOverrideTitle = False
  LegendStyle.bOverrideSubTitle = False
  If Not curTheme.Legend.Compact Then
    LegendStyle.sTitle = curTheme.Legend.Title
    LegendStyle.sSubTitle = curTheme.Legend.SubTitle
'    Set LegendStyle.txtTitle = curTheme.Legend.TitleStyle
'    Set LegendStyle.txtSubTitle = curTheme.Legend.SubTitleStyle
  Else
    LegendStyle.sTitle = curTheme.Legend.CompactTitle
'    Set LegendStyle.txtTitle = curTheme.Legend.CompactTitleStyle
  End If
'  Set LegendStyle.txtStyle = curTheme.Legend.BodyTextStyle
  LegendStyle.bFirst = True
  LegendStyle.Activate curTheme
End Sub

Private Function GetThemeSelected() As Theme
  Dim i As Integer, j As Integer, iThemeNum As Integer

  iThemeNum = 0
  For i = 1 To gMap.Datasets.Count
    For j = 1 To gMap.Datasets(i).Themes.Count
      If cmbThemes.ListIndex = iThemeNum Then
        Set GetThemeSelected = gMap.Datasets(i).Themes(j)
        Exit Function
      End If
      iThemeNum = iThemeNum + 1
    Next
  Next
  
  Set GetThemeSelected = Nothing
End Function

Private Sub cmdModify_Click()
  Dim curTheme As Theme
  
  Set curTheme = GetThemeSelected

  Select Case curTheme.Type
    Case miThemeRanged ' Ranges
      RangeOptions.RangesCount = curTheme.Properties.NumRanges
      If curTheme.Properties.DistMethod = miEqualCountPerRange Then
        RangeOptions.DistribMethod = 0
      Else
        RangeOptions.DistribMethod = 1
      End If
      If curTheme.Properties.SpreadBy = miSpreadByColor Then
        RangeOptions.iMethod = 1 ' RGB
      Else
        RangeOptions.iMethod = 2 ' HSV
      End If
      RangeOptions.BeginColor = curTheme.Properties.RangeCategories(1).Style.RegionColor
      RangeOptions.EndColor = curTheme.Properties.RangeCategories(curTheme.Properties.NumRanges).Style.RegionColor
      RangeOptions.bVisible = curTheme.Visible
      RangeOptions.bInitParams = True
      RangeOptions.Activate curTheme
    Case miThemeBarChart ' Bar
      BarOptions.BarValue = curTheme.Properties.DataValue
      BarOptions.BarSize = curTheme.Properties.Size
      BarOptions.BarWidth = curTheme.Properties.Width
      BarOptions.bIndependent = curTheme.Properties.Independent
      BarOptions.bVisible = curTheme.Visible
      BarOptions.bInitParams = True
      BarOptions.Activate gMap.PaperUnit, curTheme
    Case miThemePieChart ' Pie
      PieOptions.PieValue = curTheme.Properties.DataValue
      PieOptions.PieSize = curTheme.Properties.Size
      PieOptions.bGraduated = curTheme.Properties.Graduated
      PieOptions.bVisible = curTheme.Visible
      PieOptions.bInitParams = True
      PieOptions.Activate gMap.PaperUnit, curTheme
    Case miThemeGradSymbol ' GradSymb
      GradOptions.GradValue = curTheme.Properties.DataValue
      GradOptions.GradSize = curTheme.Properties.SymbolStyle.SymbolFont.Size
      GradOptions.GradColor = curTheme.Properties.SymbolStyle.SymbolFontColor
      GradOptions.bVisible = curTheme.Visible
      GradOptions.bInitParams = True
      GradOptions.Activate curTheme
    Case miThemeDotDensity ' DotDens
      DotOptions.DotValue = curTheme.Properties.ValuePerDot
      If curTheme.Properties.DotSize = DotSizeConstants.miDotSizeSmall Then
        DotOptions.DotSize = 0
      Else
        DotOptions.DotSize = 1
      End If
      DotOptions.bVisible = curTheme.Visible
      DotOptions.bInitParams = True
      DotOptions.Activate curTheme
  End Select
End Sub