frmthemegraduatedsymbol.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmThemeGraduatedSymbol 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "等级符号图"
   ClientHeight    =   3885
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6315
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3885
   ScaleWidth      =   6315
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Tag             =   "5132"
   Begin VB.CommandButton btnOK 
      Caption         =   "完成(&O)"
      Default         =   -1  'True
      Height          =   375
      Left            =   3255
      TabIndex        =   16
      Tag             =   "3133"
      Top             =   3465
      Width           =   1200
   End
   Begin VB.CommandButton btnCancel 
      Cancel          =   -1  'True
      Caption         =   "放弃(&C)"
      Height          =   375
      Left            =   4830
      TabIndex        =   15
      Tag             =   "3058"
      Top             =   3465
      Width           =   1200
   End
   Begin VB.CommandButton btnBack 
      Caption         =   "上一步(&B)"
      Height          =   375
      Left            =   2055
      TabIndex        =   14
      Tag             =   "3129"
      Top             =   3465
      Width           =   1200
   End
   Begin VB.Frame Frame2 
      Caption         =   "正值风格"
      Height          =   1500
      Left            =   2280
      TabIndex        =   8
      Tag             =   "5372"
      Top             =   1680
      Width           =   1530
      Begin VB.PictureBox picPositive 
         AutoRedraw      =   -1  'True
         Height          =   780
         Left            =   90
         ScaleHeight     =   720
         ScaleWidth      =   1275
         TabIndex        =   13
         Top             =   240
         Width           =   1335
      End
      Begin VB.CommandButton btnChangePositive 
         Appearance      =   0  'Flat
         Caption         =   "修     改"
         Height          =   360
         Left            =   90
         TabIndex        =   9
         Tag             =   "5374"
         Top             =   1080
         Width           =   1320
      End
   End
   Begin VB.CheckBox chkShowNegative 
      Caption         =   "负值风格"
      Height          =   240
      Left            =   4260
      TabIndex        =   7
      Tag             =   "5373"
      Top             =   1620
      Width           =   1425
   End
   Begin VB.Frame Frame1 
      Height          =   1500
      Left            =   4200
      TabIndex        =   6
      Top             =   1650
      Width           =   1530
      Begin VB.CommandButton btnChangeNegative 
         Appearance      =   0  'Flat
         Caption         =   "修     改"
         Height          =   360
         Left            =   75
         TabIndex        =   10
         Tag             =   "5374"
         Top             =   1080
         Width           =   1365
      End
      Begin VB.PictureBox picNegative 
         Height          =   780
         Left            =   90
         ScaleHeight     =   720
         ScaleWidth      =   1290
         TabIndex        =   12
         Top             =   240
         Width           =   1350
      End
   End
   Begin MSComCtl2.UpDown UpDown1 
      Height          =   240
      Left            =   5640
      TabIndex        =   4
      Top             =   720
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   423
      _Version        =   393216
      BuddyControl    =   "txtDefVal"
      BuddyDispid     =   196620
      OrigLeft        =   5235
      OrigTop         =   645
      OrigRight       =   5475
      OrigBottom      =   885
      Max             =   1000000000
      SyncBuddy       =   -1  'True
      BuddyProperty   =   65547
      Enabled         =   -1  'True
   End
   Begin VB.ComboBox cmbFieldName 
      Height          =   315
      Left            =   3720
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   240
      Width           =   2175
   End
   Begin VB.TextBox txtDefVal 
      Height          =   285
      Left            =   3720
      TabIndex        =   3
      Top             =   690
      Width           =   2175
   End
   Begin VB.ComboBox cmbGraduatedMode 
      Height          =   315
      Left            =   3720
      Style           =   2  'Dropdown List
      TabIndex        =   11
      Top             =   1200
      Width           =   2175
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   3090
      Left            =   300
      Picture         =   "frmThemeGraduatedSymbol.frx":0000
      Top             =   150
      Width           =   1695
   End
   Begin VB.Label Label2 
      Caption         =   "等级符号值"
      Height          =   210
      Left            =   2310
      TabIndex        =   2
      Tag             =   "5383"
      Top             =   795
      Width           =   1440
   End
   Begin VB.Label Label1 
      Caption         =   "字段名称"
      Height          =   210
      Left            =   2310
      TabIndex        =   1
      Tag             =   "3217"
      Top             =   270
      Width           =   1365
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      X1              =   0
      X2              =   6405
      Y1              =   3345
      Y2              =   3345
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000003&
      X1              =   0
      X2              =   6405
      Y1              =   3330
      Y2              =   3330
   End
   Begin VB.Label Label4 
      Caption         =   "分段方式"
      Height          =   210
      Left            =   2280
      TabIndex        =   5
      Tag             =   "3246"
      Top             =   1320
      Width           =   1425
   End
End
Attribute VB_Name = "frmThemeGraduatedSymbol"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'说 明：用来创建等级符号专题图
Option Explicit

Dim objPositiveStyle As New soStyle
Dim objNegativeStyle As New soStyle

Private Sub btnBack_Click()
    Unload Me
    frmTheme1.Show
End Sub

Private Sub btnCancel_Click()
    Unload Me
    Unload frmTheme1
End Sub

Private Sub btnChangeNegative_Click()
    Dim nx As Integer
    Dim ny As Integer

    If (frmMain.SuperWorkspace1.Resources.SymbolLib.ShowPicker(objNegativeStyle)) Then
        picNegative.Cls        '清掉原图
        
        nx = ScaleX(picNegative.Width / 2, vbTwips, vbPixels)
        ny = ScaleY(picNegative.Height / 2, vbTwips, vbPixels)
        frmMain.SuperWorkspace1.Resources.SymbolLib.Draw picNegative.hDC, nx, ny, objNegativeStyle
    End If
End Sub

Private Sub btnChangePositive_Click()
    Dim nx As Integer
    Dim ny As Integer
      
    If (frmMain.SuperWorkspace1.Resources.SymbolLib.ShowPicker(objPositiveStyle)) Then
       
       picPositive.Cls         '清掉原图
       nx = ScaleX(picPositive.Width / 2, vbTwips, vbPixels)
       ny = ScaleY(picPositive.Height / 2, vbTwips, vbPixels)
       frmMain.SuperWorkspace1.Resources.SymbolLib.Draw picPositive.hDC, nx, ny, objPositiveStyle
       picPositive.Refresh
     End If
      
End Sub

Private Sub btnOK_Click()
      Dim objLayer As soLayer
      Dim objThemeGraduatedSymbol  As soThemeGraduatedSymbol

      Set objLayer = frmMain.SuperMap1.Layers.Item(frmTheme1.cmbLayerName.Text)
      If objLayer Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      End If
      Set objThemeGraduatedSymbol = objLayer.ThemeGraduatedSymbol
      If objThemeGraduatedSymbol Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      Else
            With objThemeGraduatedSymbol
                  .DefinitionValue = CDbl(Val(txtDefVal.Text))
                  .Field = cmbFieldName.Text
                  .ShowNegative = IIf(chkShowNegative.Value = vbChecked, True, False)
                  .StyleForPositive = objPositiveStyle
                  If .ShowNegative = True Then
                        .StyleForNegative = objNegativeStyle
                  End If
                  If cmbGraduatedMode.ListIndex = "0" Then
                        .GraduatedMode = scgConstant
                  ElseIf cmbGraduatedMode.ListIndex = "1" Then
                        .GraduatedMode = scgSquareRoot
                  ElseIf cmbGraduatedMode.ListIndex = "2" Then
                        .GraduatedMode = scgLog
                  End If
                  .Enable = True
            End With
            frmMain.SuperMap1.Refresh
      End If
      Set objLayer = Nothing
      Set objThemeGraduatedSymbol = Nothing
      frmMain.SuperMap1.Refresh
      Unload Me
      Unload frmTheme1
End Sub

Private Sub chkShowNegative_Click()
      Dim nx As Long, ny As Long
      
      If chkShowNegative.Value = vbChecked Then
            picNegative.Enabled = True
            btnChangeNegative.Enabled = True
            
            objNegativeStyle.SymbolStyle = 0
            objNegativeStyle.SymbolSize = 150
            objNegativeStyle.PenColor = vbBlue
            nx = ScaleX(picNegative.Width / 2, vbTwips, vbPixels)
            ny = ScaleY(picNegative.Height / 2, vbTwips, vbPixels)
            frmMain.SuperWorkspace1.Resources.SymbolLib.Draw picNegative.hDC, nx, ny, objNegativeStyle
      Else
            picNegative.Enabled = False
           picNegative.Cls
            btnChangeNegative.Enabled = False
      End If
End Sub

Private Sub cmbFieldName_Click()
      Dim objLayer As soLayer
      Dim objThemeGraduatedSymbol  As soThemeGraduatedSymbol

      Set objLayer = frmMain.SuperMap1.Layers.Item(frmTheme1.cmbLayerName.Text)
      If objLayer Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      End If
      Set objThemeGraduatedSymbol = objLayer.ThemeGraduatedSymbol
      If objThemeGraduatedSymbol Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      Else
            With objThemeGraduatedSymbol
                  .Field = cmbFieldName.Text
                  If .MakeDefault() = False Then Exit Sub
                  txtDefVal.Text = .DefinitionValue
                  cmbGraduatedMode.ListIndex = .GraduatedMode
                  chkShowNegative.Value = IIf(.ShowNegative = True, vbChecked, vbUnchecked)
            End With
      End If

      Set objLayer = Nothing
      Set objThemeGraduatedSymbol = Nothing
End Sub

Private Sub Form_Load()
   
      Dim objLayer As soLayer
      Dim objDtVector As soDatasetVector
      Dim objFieldInfo As soFieldInfo
      Dim i As Integer
      Dim nx As Long, ny As Long
      '设置分段方式列表框
      cmbGraduatedMode.AddItem "正常分段"
      cmbGraduatedMode.AddItem "开方分段"
      cmbGraduatedMode.AddItem "对数分段"
      cmbGraduatedMode.ListIndex = 0
      '设置字段
      Set objLayer = frmMain.SuperMap1.Layers.Item(frmTheme1.cmbLayerName.Text)
      If objLayer Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      End If
      Set objDtVector = objLayer.Dataset
      If objDtVector Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      End If
      objDtVector.Open

      For i = 1 To objDtVector.FieldCount
            Set objFieldInfo = objDtVector.GetFieldInfo(i)
            If objFieldInfo Is Nothing Then
                  MsgBox "错误！", vbInformation
                  Exit Sub
            End If
            Select Case objFieldInfo.Type
                  Case scfInteger, scfDouble, scfLong, scfSingle
                        cmbFieldName.AddItem objFieldInfo.Name
            End Select
      Next
      If cmbFieldName.ListCount > 0 Then cmbFieldName.ListIndex = 1
      '画正值的符号
     objPositiveStyle.SymbolStyle = 0
     objPositiveStyle.SymbolSize = 150
     objPositiveStyle.PenColor = vbRed
     nx = ScaleX(picPositive.Width / 2, vbTwips, vbPixels)
     ny = ScaleY(picPositive.Height / 2, vbTwips, vbPixels)
     frmMain.SuperWorkspace1.Resources.SymbolLib.Draw picPositive.hDC, nx, ny, objPositiveStyle

     btnChangeNegative.Enabled = False
'      objDtVector.Close
      Set objLayer = Nothing
      Set objDtVector = Nothing
      Set objFieldInfo = Nothing
End Sub

Private Sub txtDefVal_KeyPress(KeyAscii As Integer)
      If KeyAscii > Asc("9") Or KeyAscii < Asc("0") Then
            If (KeyAscii <> vbKeyBack) And (KeyAscii <> Asc(".")) Then
                  KeyAscii = 0
                  Beep
            End If
      End If
End Sub