rangeoptions.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form RangeOptions 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Range Options"
   ClientHeight    =   4395
   ClientLeft      =   1140
   ClientTop       =   1515
   ClientWidth     =   5085
   Icon            =   "RangeOptions.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4395
   ScaleWidth      =   5085
   ShowInTaskbar   =   0   'False
   Begin VB.CheckBox ckVisible 
      Caption         =   "Theme is &visible"
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   3300
      Width           =   1695
   End
   Begin VB.Frame frmStyle 
      Caption         =   "Ranges style"
      Height          =   1815
      Left            =   240
      TabIndex        =   4
      Top             =   1260
      Width           =   4575
      Begin VB.OptionButton rbHSV 
         Caption         =   "&HSV"
         Height          =   315
         Left            =   3120
         TabIndex        =   11
         Top             =   1260
         Width           =   795
      End
      Begin VB.OptionButton rbRGB 
         Caption         =   "&RGB"
         Height          =   315
         Left            =   2220
         TabIndex        =   10
         Top             =   1260
         Width           =   795
      End
      Begin VB.PictureBox pctBeginColor 
         BackColor       =   &H00000000&
         Height          =   495
         Left            =   1500
         ScaleHeight     =   435
         ScaleWidth      =   495
         TabIndex        =   6
         Top             =   420
         Width           =   555
      End
      Begin VB.PictureBox pctEndColor 
         BackColor       =   &H00000000&
         Height          =   495
         Left            =   3420
         ScaleHeight     =   435
         ScaleWidth      =   495
         TabIndex        =   8
         Top             =   420
         Width           =   555
      End
      Begin VB.Label lblSpreadMethod 
         Caption         =   "Color spread method:"
         Height          =   255
         Left            =   360
         TabIndex        =   9
         Top             =   1320
         Width           =   1575
      End
      Begin VB.Label lblBeginColor 
         Caption         =   "Begin color:"
         Height          =   255
         Left            =   360
         TabIndex        =   5
         Top             =   540
         Width           =   975
      End
      Begin VB.Label lblEndColor 
         Caption         =   "End color:"
         Height          =   255
         Left            =   2400
         TabIndex        =   7
         Top             =   540
         Width           =   855
      End
   End
   Begin VB.ComboBox cmbDistrib 
      Height          =   315
      ItemData        =   "RangeOptions.frx":000C
      Left            =   1800
      List            =   "RangeOptions.frx":0016
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   720
      Width           =   1815
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   2580
      TabIndex        =   13
      Top             =   3840
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   1140
      TabIndex        =   14
      Top             =   3840
      Width           =   1215
   End
   Begin VB.ComboBox cmbRangesNumber 
      Height          =   315
      ItemData        =   "RangeOptions.frx":0035
      Left            =   1800
      List            =   "RangeOptions.frx":005D
      TabIndex        =   1
      Top             =   240
      Width           =   1155
   End
   Begin MSComDlg.CommonDialog dlgSpecifyColor 
      Left            =   4140
      Top             =   3720
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Flags           =   1
   End
   Begin VB.Label lblDistrib 
      Caption         =   "&Distribution method:"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   780
      Width           =   1455
   End
   Begin VB.Label lblNumRanges 
      Caption         =   "&Number of ranges:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   300
      Width           =   1395
   End
End
Attribute VB_Name = "RangeOptions"
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.

Public RangesCount As Integer
Public DistribMethod As Integer ' 1 - Equal ranges, 0 - Equal count
Public BeginColor, EndColor As Long, bInitParams As Boolean
Public iMethod As Integer, bVisible As Boolean
Public bOptionsSet As Boolean

Dim Rng As Variant, gTheme As Theme, bTheme As Boolean

Private Sub InitRanges()
  cmbRangesNumber.Text = RangesCount
  cmbDistrib.ListIndex = DistribMethod
  pctBeginColor.BackColor = BeginColor
  pctEndColor.BackColor = EndColor
  Select Case iMethod
    Case 1 ' RGB
      rbRGB.Value = True
      rbHSV.Value = False
    Case 2 ' HSV
      rbRGB.Value = False
      rbHSV.Value = True
  End Select
  If bVisible Then
    ckVisible.Value = 1
  Else
    ckVisible.Value = 0
  End If
End Sub

Private Sub cmdCancel_Click()
  Hide
End Sub

Public Sub Activate(Optional tTheme)
  If Not bInitParams Then
    RangesCount = 5
    DistribMethod = 0
    BeginColor = vbWhite
    EndColor = 8421504
    iMethod = 1 ' RGB
    bVisible = True
    bInitParams = True
  End If
  
  If Not IsMissing(tTheme) Then
    Set gTheme = tTheme
    bTheme = True
  Else
    bTheme = False
  End If
  
  InitRanges
  FormToCenter hWnd
  Show 1
End Sub

Private Sub cmdOk_Click()
  Dim i As Integer, lResRGB() As Long

  RangesCount = Val(cmbRangesNumber.Text)
  DistribMethod = cmbDistrib.ListIndex
  BeginColor = pctBeginColor.BackColor
  EndColor = pctEndColor.BackColor
  If rbRGB.Value Then
    iMethod = 1
  Else
    iMethod = 0
  End If
  bVisible = (ckVisible.Value = 1)
  bOptionsSet = True
  
  If bTheme Then
    gTheme.AutoRecompute = False
    With gTheme.Properties
      .NumRanges = RangesCount
      If DistribMethod = 0 Then
        .DistMethod = miEqualCountPerRange
      Else
        .DistMethod = miEqualRangeSize
      End If
      If iMethod = 1 Then
        .SpreadBy = miSpreadByColor
        .RangeCategories(1).Style.RegionColor = BeginColor
        .RangeCategories(.RangeCategories.Count).Style.RegionColor = EndColor
      Else
        .SpreadBy = miSpreadByNone
        ReDim lResRGB(.RangeCategories.Count)
        Fill_HSV_Colors BeginColor, EndColor, .RangeCategories.Count, lResRGB
        For i = 1 To .RangeCategories.Count
          .RangeCategories(i).Style.RegionColor = lResRGB(i)
        Next
      End If
    End With
    gTheme.AutoRecompute = True
    gTheme.Visible = bVisible
  End If
  
  Hide
End Sub

Private Sub pctBeginColor_Click()
  dlgSpecifyColor.Color = pctBeginColor.BackColor
  dlgSpecifyColor.ShowColor
  If Not dlgSpecifyColor.CancelError Then
    pctBeginColor.BackColor = dlgSpecifyColor.Color
  End If
End Sub

Private Sub pctEndColor_Click()
  dlgSpecifyColor.Color = pctEndColor.BackColor
  dlgSpecifyColor.ShowColor
  If Not dlgSpecifyColor.CancelError Then
    pctEndColor.BackColor = dlgSpecifyColor.Color
  End If
End Sub